20.09.2017, 13:27
Hallo liebe Forumgemeinde,
ich bin im Internet auf folgenden Code gestoßen um eine Ordner- und Dateiliste in Excel erstellen zu können.
(http://www.ozgrid.com/forum/showthread.php?t=174821)
Hiermit erhalte ich folgende Übersicht über einen Ordner und die enthaltenen Unterordner sowie Dateien:
[Bild: 116389.jpg]
Gerne würde ich aber eine Übersicht erhalten, die folgendermaßen aussieht:
[Bild: 116390.jpg]
Leider ist es mir bis jetzt noch nicht gelungen dies zu erreichen.
Ich habe im Nachhinein versucht die leeren Zellen mit der Zelle von oben drüber aufzufüllen.
Jedoch konnte ich hierbei nicht festlegen, dass er nur Zellen mit "FOLDER_" als Inhalt kopiert.
Vielleicht kann mir jemand bei meinem Problem helfen und es ist keine große Änderung an dem Ursprungscode nötig.
Ich würde mich sehr über eine Antwort freuen und bedanke mich schon mal recht herzlich.
Viele Grüße
Os
ich bin im Internet auf folgenden Code gestoßen um eine Ordner- und Dateiliste in Excel erstellen zu können.
(http://www.ozgrid.com/forum/showthread.php?t=174821)
Code:
Option Explicit
Private iColumn As Integer
Sub TestListFolders(strPath As String, Optional bFolders As Boolean = True)
Application.ScreenUpdating = False
Cells.Delete
Range("A1").Select
iColumn = 1
' add headers
With Range("A1")
.Formula = "Folder contents: " & strPath
.Font.Bold = True
.Font.Size = 12
End With
If Right(strPath, 1) <> "" Then
strPath = strPath & ""
End If
ListFolders strPath, bFolders
Application.ScreenUpdating = True
End Sub
Sub ListFolders(SourceFolderName As String, IncludeSubfolders As Boolean)
' lists information about the folders in SourceFolder
' example: ListFolders "C:", True
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim r As Long
Dim strfile As String
Set FSO = New Scripting.FileSystemObject
Set SourceFolder = FSO.GetFolder(SourceFolderName)
'line added by dr for repeated "Permission Denied" errors
On Error Resume Next
iColumn = iColumn + 1
' display folder properties
ActiveCell.Offset(1).Select
With Cells(ActiveCell.Row, iColumn)
.Formula = SourceFolder.Name
.Font.ColorIndex = 11
.Font.Bold = True
.Select
End With
strfile = Dir(SourceFolder.Path & "*.*")
If strfile <> vbNullString Then
ActiveCell.Offset(0, 1).Select
Do While strfile <> vbNullString
ActiveCell.Offset(1).Select
ActiveCell.Value = strfile
strfile = Dir
Loop
ActiveCell.Offset(0, -1).Select
End If
' Cells(r, 2).Formula = SourceFolder.Name
' Cells(r, 3).Formula = SourceFolder.Size
' Cells(r, 4).Formula = SourceFolder.SubFolders.Count
' Cells(r, 5).Formula = SourceFolder.Files.Count
' Cells(r, 6).Formula = SourceFolder.ShortName
' Cells(r, 7).Formula = SourceFolder.ShortPath
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFolders SubFolder.Path, True
iColumn = iColumn - 1
Next SubFolder
Set SubFolder = Nothing
End If
Set SourceFolder = Nothing
Set FSO = Nothing
End SubHiermit erhalte ich folgende Übersicht über einen Ordner und die enthaltenen Unterordner sowie Dateien:
[Bild: 116389.jpg]
Gerne würde ich aber eine Übersicht erhalten, die folgendermaßen aussieht:
[Bild: 116390.jpg]
Leider ist es mir bis jetzt noch nicht gelungen dies zu erreichen.
Ich habe im Nachhinein versucht die leeren Zellen mit der Zelle von oben drüber aufzufüllen.
Jedoch konnte ich hierbei nicht festlegen, dass er nur Zellen mit "FOLDER_" als Inhalt kopiert.
Vielleicht kann mir jemand bei meinem Problem helfen und es ist keine große Änderung an dem Ursprungscode nötig.
Ich würde mich sehr über eine Antwort freuen und bedanke mich schon mal recht herzlich.
Viele Grüße
Os