Re: header/footer auslesen
24.03.2003 12:32:49
Tim
Ok, aber mit den Methoden, die ich bisher benutze ist es wie gesagt nicht möglich auf den Header der Worddateien zuzugreifen. Mein Code funktioniert im Grunde so:Sub Dateisuche(Laufwerk, Dateien, z, Folderindex)
Dim objFS As New Scripting.FileSystemObject
Dim objFile As Scripting.File
Dim oFilePropReader As DSOleFile.PropertyReader
Dim iProp As DSOleFile.DocumentProperties
Set oFilePropReader = New DSOleFile.PropertyReader
Dim tmp, Wdhlg, Dateiname As String
On Error Resume Next
If Right(Laufwerk, 1) <> "\" Then Laufwerk = Laufwerk + "\"
tmp = Dir(Laufwerk & Dateien)
Do While Len(tmp)
Dateiname = Laufwerk & tmp
Application.StatusBar = Dateiname
Set iProp = oFilePropReader.GetDocumentProperties(Dateiname)
Set objFile = objFS.GetFile(Dateiname)
Cells(z, 3) = objFile.Type
Cells(z, 4) = Laufwerk & tmp
Cells(z, 5) = iProp.Author
Cells(z, 6) = iProp.LastEditedBy
Cells(z, 7) = iProp.manager
Cells(z, 8) = iProp.DateCreated
Cells(z, 9) = iProp.DateLastSaved
Cells(z, 10) = iProp.HasMacros
Cells(z, 11) = iProp.Comments
Cells(z, 12) = iProp.Keywords
If iProp.Thumbnail <> "" Then
Cells(z, 13) = "ja"
Else
Cells(z, 13) = "nein"
End If
Cells(z, 14) = iProp.title
Cells(z, 15) = iProp.CustomProperties.Item("Fehlerbeschreibung")
Cells(z, 16) = iProp.CustomProperties.Item("XP getestet")
Cells(z, 17) = iProp.CustomProperties.Item("Fehler unter XP")
Cells(z, 18) = iProp.CustomProperties.Item("Formularfelder")
Cells(z, 19) = iProp.CustomProperties.Item("Last checked")
If Cells(z, 9) > Cells(z, 19) Then
Cells(z, 20) = "neu"
End If
Cells(z, 22) = iProp.PageCount
iProp.CustomProperties.Item("Last checked") = Date
z = z + 1
tmp = Dir()
Cells(1, 4).Value = z - 4
Loop
tmp = Dir(Laufwerk, vbDirectory)
Do While Len(tmp)
If (tmp <> ".") And (tmp <> "..") Then
If (GetAttr(Laufwerk & tmp) And vbDirectory) = vbDirectory Then
Dateisuche Laufwerk & tmp, Dateien, z, Folderindex
z = z - 1
Wdhlg = Dir(Laufwerk, vbDirectory)
z = z + 1
Do While Wdhlg <> tmp
Wdhlg = Dir()
Loop
End If
End If
tmp = Dir()
Loop
On Error GoTo 0
Application.StatusBar = False
Folderindex = Folderindex + 1
Cells(1, 3).Value = Folderindex
End Sub
Die Ordnerstruktur wird also nach Doc's durchsucht, jedes gefundene Dokument wird in der Schleife als Scripting File Objekt gesetzt, die Eigenschaften werden mit der iProp Funktion ausgelesen und alles wird hübsch untereinander in das Excelsheet eingetragen. Hinterher hat man ein Sheet, in dem alle gefundenen Dokumente so aufgelistet sind:
Dok-Name ; Link ; Typ ; Pfad ; Autor ; Last Editet by ; Manager ; usw.
Insgesamt 22 Spalten. Nun kann ich das Excelsheet editieren und starte eine zweite Funktion, die in einer Schleife alle Dikumente aus dem Sheet liest (den Pfad + Dok Name) und nun die neuen Werte für die Properties aus der Liste liest und in die Dokumente schreibt. Das ganze würde ich nun gerne um die genannte Funktion erweitern, dass innerhalb dieser zweiten Schleife ein neuer Header in das Dokument geschrieben wird. Ist mit den objFile oder iProp die ich verwende aber nicht möglich...