Hallo zusammen,
bin am verzweifeln und schon stundenlang am ausprobieren. Komme aber auf keinen "grünen Zweig". Möchte hier noch gerne die fehlenden Dateieigenschaften (FileLänge & Bildweite / Bildhöhe eingebaut bekommen).
Private Sub alleDateien(ByVal stgDir As String)
Dim objFSO As Object
Dim objOrdner As Object
Dim objUnterordner As Object
Dim objDatei As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objOrdner = objFSO.GetFolder(stgDir)
With objSheetD
For Each objUnterordner In objOrdner.subFolders
For Each objDatei In objUnterordner.Files
.Cells(lngZeileDa, 1) = objUnterordner.Path
.Cells(lngZeileDa, 2) = Left(objDatei.DateCreated, 10)
.Cells(lngZeileDa, 3) = objDatei.Name
.Cells(lngZeileDa, 4) = Round(objDatei.Size / 1024, 0)
.Cells(lngZeileDa, 5) = Left(objDatei.DateLastAccessed, 10)
.Cells(lngZeileDa, 6) = Left(objDatei.DateLastModified, 10)
.Cells(lngZeileDa, 7) = objDatei.Type
lngZeileDa = lngZeileDa + 1
Next objDatei
Call alleDateien(objUnterordner.Path)
Next objUnterordner
End With
Set objFSO = Nothing
Set objDatei = Nothing
Set objOrdner = Nothing
Set objUnterordner = Nothing
End Sub
MfG Butzie