AW: Dateinamen in Liste einfügen
07.11.2005 09:48:54
Marc
Hallo Andre,
damit alles schön automatisiert ist:
Sub DateiEigenschaften()
'Trägt die Dateieigenschaften aller Dateien 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 = InputBox("Aus welchem Ordner?", Default:="C:\")
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=ja/False=nein
.FileType = msoFileTypeExcelWorkbooks 'msoFileTypeAllFiles
.Execute
For iCnt = 1 To .FoundFiles.Count
Set wkb = Workbooks.Open(.FoundFiles(iCnt))
actSht.Cells(lRow, 1) = wkb.Name
actSht.Cells(lRow, 1).Font.Bold = True
'lRow = lRow + 1
With wkb
n = 12
'For n = 1 To wkb.BuiltinDocumentProperties.Count 'für alle Eigenschaften
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 'wenn For n
wkb.Close , False
End With
lRow = lRow + 1
Next
End With
Columns("A:A").Replace What:=".xls", Replacement:=""
actSht.Columns.AutoFit
actSht.Columns("A:B").HorizontalAlignment = xlLeft
ERRORHANDLER:
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
End Sub