Sub Dateieigenschaften()
'von k.rola
Const STRFOLDER As String = "D:\Daten" 'anpassen
Dim objShell As Object
Dim objFolder As Object
Dim x As Byte
Dim spalte As Integer
Dim zeile As Long
Dim varName, arrHeaders(34)
If Dir(STRFOLDER, 16) = "" Then
MsgBox "Der Ordner " & STRFOLDER & " wurde nicht gefunden!" & Space(10), 64, "weise hin..."
Exit Sub
End If
Application.ScreenUpdating = False
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(STRFOLDER)
spalte = 1
For x = 0 To 33
arrHeaders(x) = objFolder.GetDetailsOf(varName, x)
Cells(1, spalte + x) = arrHeaders(x)
Next
Rows(1).Font.Bold = True
zeile = 2
For Each varName In objFolder.Items
For x = 0 To 33
Cells(zeile, spalte + x) = objFolder.GetDetailsOf(varName, x)
Next
zeile = zeile + 1
Next
Columns.AutoFit
Application.ScreenUpdating = True
End Sub