Eigenschaften @ Sepp

Sub DateiEigenschaften()
'by J.Ehrensberger
'Trägt die Dateieigenschaften aller Exceldateien eines Verzeichnises
'mit Unterverzeichnissen in die aktuelle Tabelle ein!
'Die Tabelle wird vorher gelöscht (Inhalt)!
Dim fSearch As FileSearch
Dim wkb As Workbook, actSht As Worksheet
Dim strPath As String
Dim iCnt As Integer, n As Integer
Dim lRow As Long
On Error GoTo ERRORHANDLER
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
End With
strPath = "C:\Eigene Dateien"
lRow = 1
Set actSht = ActiveSheet
With actSht
.Cells.ClearContents
.Cells.ClearFormats
End With
Set fSearch = Application.FileSearch
With fSearch
.NewSearch
.LookIn = strPath
.SearchSubFolders = True  '<<<<Unterordner durchsuchen True/False
.FileType = msoFileTypeAll
.Execute
For iCnt = 1 To .FoundFiles.Count
Set wkb = Workbooks.Open(.FoundFiles(iCnt))
actSht.Cells(lRow, 1) = wkb.FullName
actSht.Cells(lRow, 1).Font.Bold = True
lRow = lRow + 1
With wkb
For n = 1 To wkb.BuiltinDocumentProperties.Count
On Error Resume Next
actSht.Cells(lRow, 1).Value = _
wkb.BuiltinDocumentProperties(n).Name
actSht.Cells(lRow, 2).Value = _
wkb.BuiltinDocumentProperties(n)
If InStr(1, wkb.BuiltinDocumentProperties(n).Name, "date") Or _
InStr(1, wkb.BuiltinDocumentProperties(n).Name, "time") And _
wkb.BuiltinDocumentProperties(n) <> 0 Then
actSht.Cells(lRow, 2).NumberFormat = "dd.mm.yyyy hh:mm:ss"
End If
If Err > 0 Then
Err.Clear
actSht.Cells(lRow, 2).Value = "k.A."
End If
On Error GoTo ERRORHANDLER
lRow = lRow + 1
Next
wkb.Close , False
End With
lRow = lRow + 1
Next
End With
actSht.Columns.AutoFit
actSht.Columns("A:B").HorizontalAlignment = xlLeft
ERRORHANDLER:
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
End 

Sub