Dateieigenschaften in Unterverzeichnissen
19.02.2005 13:10:13
Nadine
Ich bin am verzweifeln.
Mit dem Application.FileSearch habe ich mir eine Liste aller Files eines Folders INKLUSIVE unterverzeichnisse gemacht.
Mit dem DSOleFile kann ich nun alle Dateieigenschaften auslesen. SUPER.
Leider scheitere ich daran, die Dateieigenschaften der Dateien in den Unterverzeichnissen auszulesen.
Kann mir da IRGENDJEMAN mit einem heissen Tip helfen.
Ihr seit lieb
Danke Nadine
Hier der bisherige CODE
'*****************************************************
' Diese (was auch immer es ist) soll alle Dateien
' in einem Verzeichnis UND dessen Unterverzeichnisse
' auslesen.
' Wichtig sind die Dateieigenschaften inkl. der
' angepassten Dateieigenschaften.
'*****************************************************
Sub OfficeDateienAuslesen()
' Dies löscht das bestehende Dokument
With Worksheets("Dokumente")
.Range(.Cells(2, 1), .Cells(256, 256)).ClearContents
End With
' Das ist die Filesuche ....
Dim lngAkt As Long
Dim rngBereich As Range
Dim rngZelle As Range
' Das Ist das Starverzeichnis für die Suche
Verzeichnis = InputBox(("Bitte geben Sie den Pfad für die Auswertung ein."), "Dateiauswertung von Urs Salvisberg", "C:\ALWIN\Aenderung")
With Application.FileSearch
.NewSearch
.LookIn = Verzeichnis
.SearchSubFolders = True
'.FileType =
.Execute
MsgBox .FoundFiles.Count & " Datei(en) gefunden!"
For lngAkt = 1 To .FoundFiles.Count
ZeileAkt = lngAkt + 1
' ---Cells(lngAkt, 1) = Mid(.FoundFiles.Item(lngAkt), InStrRev(.FoundFiles.Item(lngAkt), "\") + 1)
' MsgBox Mid(.FoundFiles.Item(lngAkt), InStrRev(.FoundFiles.Item(lngAkt), "\") + 1)
'datei = Mid(.FoundFiles.Item(lngAkt), InStrRev(.FoundFiles.Item(lngAkt), "\") + 1)
datei = .FoundFiles.Item(lngAkt)
With Worksheets("Dokumente")
Dim objFilePropReader As DSOleFile.PropertyReader
Dim objFileProp As DSOleFile.DocumentProperties
Set objFilePropReader = New DSOleFile.PropertyReader
Set objFileProp = objFilePropReader.GetDocumentProperties(datei)
On Error Resume Next
Dim objFileCustProp As DSOleFile.CustomProperty
.Cells(ZeileAkt, 1) = lngAkt
.Cells(ZeileAkt, 2) = datei
.Cells(ZeileAkt, 3) = objFileProp.Category
.Cells(ZeileAkt, 4) = objFileProp.Title
.Cells(ZeileAkt, 5) = objFileProp.Name
.Cells(ZeileAkt, 6) = lngAkt
.Cells(ZeileAkt, 7) = objFileProp.Manager
.Cells(ZeileAkt, 8) = objFileProp.Author
.Cells(ZeileAkt, 9) = objFileProp.Comments
.Cells(ZeileAkt, 10) = objFileProp.DateCreated
.Cells(ZeileAkt, 11) = objFileProp.DateLastSaved
.Cells(ZeileAkt, 12) = objFileProp.DateLastPrinted
AnzahlCustProp = 0
StartZelle = 13
For Each objFileCustProp In objFileProp.CustomProperties
.Cells(2, StartZelle + AnzahlCustProp) = objFileCustProp.Name & " " & objFileCustProp.Value
AnzahlCustProp = AnzahlCustProp + 1
Next
End With
Next lngAkt
End With
Set objFilePropReader = Nothing
Set objDocProp = Nothing
Set myFileSystemObject = Nothing
Application.ScreenUpdating = True
End Sub