Auslesen Dokumentinformationen
Micha555
ich muss für hunderte von Office Dokumenten (und pdfs, aber Office wäre schon mal mehr als super!) die Dokumentinformationen in eine Excel Liste eintragen.
Jetzt habe ich hier (https://www.herber.de/forum/archiv/688to692/t691669.htm) einen Beitrag gefunden, der eigentlich genau das macht, was ich brauche (Habe den VBA Code mal unten eingefügt).
Leider funktioniert das nur für Excel-Dateien. Wenn ich das Makro auf ".FileType = msoFileTypeAllFiles" umstelle, bricht es bei einer Word Datei ab und geht in den ERROR Pfad. Soweit ich das verstehe kann er die Word-Datei nicht öffnen.......ich bekomme aber auch keine echte Fehlermeldung, so dass ich debuggen könnte.
Muss ich da noch irgendwas beachten? Mach ich was falsch? Hat jemand eine gute Idee oder gibt es einen anderen Weg, meine Aufgabe hinzubekommen?
Gruss und vielen Dank
Micha
Das Makro
----------------------------------------
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 ' 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
Anzeige