Verzeichnis auslesen auf Unterordner erweitern
06.05.2016 11:20:52
Constantin
da ich Dateieigenschaften auslesen möchte, bin ich mit dem Hinweis auf nachfolgendes Programm schon ein Stück weitergekommen.
Soweit ich erkennen kann, wird nur das Ausgangsverzeichnis ausgelesen und keine Unterordner. Ließe sich das noch einbauen? Der Pfad sollte dann in einer eigenen Spalte stehen. Falls möglich, der Dateiname noch mit der Extension ergänzt.
Im Voraus vielen Dank für eine Rückmeldung.
Grüße, Constantin
Sub Einlesen()
Dim myPath
Dim fd As FileDialog
Dim datei As String
Dim Ze As Long, AnzZe As Long
Const AnzSp As Long = 35
Dim arrHeaders, arrErg
Dim objShell As Object, objFolder As Object, strFilename As Variant
Dim I As Long
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
If fd.Show Then
Cells(4, 1).CurrentRegion.ClearContents
myPath = fd.SelectedItems(1)
Cells(1, 2).Value = myPath & "\"
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(myPath)
ReDim arrHeaders(1 To 2, 1 To AnzSp)
For I = 1 To AnzSp
arrHeaders(2, I) = I - 1
arrHeaders(1, I) = objFolder.GetDetailsOf(objFolder.Items, I - 1)
Next
Cells(4, 1).Resize(2, AnzSp) = arrHeaders
AnzZe = objFolder.Items.Count
ReDim arrErg(1 To AnzZe, 1 To AnzSp)
For Each strFilename In objFolder.Items
If objFolder.GetDetailsOf(strFilename, 2) "Dateiordner" Then
Ze = Ze + 1
Application.StatusBar = "Gelesen: " & Ze & " von " & AnzZe
For I = 1 To AnzSp
arrErg(Ze, I) = Trim(objFolder.GetDetailsOf(strFilename, I - 1))
Next
End If
Next strFilename
Cells(6, 1).Resize(AnzZe, AnzSp) = arrErg
Application.StatusBar = False
End If
End Sub