Document Inspector von Office 2007 automatisieren per Macro

Question

Hallo!

Ich möchte den Document Inspector dafür nutzen, um in Office 2007 mehrere Word-Dokumente auf einmal von persönlichen Daten zu bereinigen. Habe lange gesucht, aber im Internet gibt es kein Freeware-Programm o.ä. das dies könnte, nur teure Spezial-Programme ( http://www.digitalconfidence.com/BatchPurifier.html oder http://esqinc.com/section/products/2/iscrub.html ). Für Office 2003 gibt es immerhin das Add-in RHD (http://www.microsoft.com/download/en/details.aspx?id=8446), das man über die Kommandozeile betreiben kann (http://support.microsoft.com/kb/834427)
Nun meine Bitte als Macro-Nullchecker: Könnte jemand aus dem Forum hier mithilfe dieser Infos Auf http://msdn.microsoft.com/en-us/library/aa338203(v=office.12).aspx#office12_usingdocumentinspector_samples
ein Add-in schreiben, das beliebig viele Word-Files bereinigt? Dasselbe für PDF-Dateien wäre auch klasse!
->Mit so einem tollen Projekt könnte man sich sicher verewigen in der Community!

Gruß,
Theophilix

Answer 1

Hallo Theophilix,

für die Entfernung der Office-Metadaten bringt Win7 das entsprechende Werkzeug mit. Einfach die Eigenschaften der Datei aufrufen, auf Details gehen und 'Eigenschaften und persönliche Informationen entfernen' auswählen. Einen Haken hat die Sache aber. Sofern man mehrere Dateien ausgewählt hat, was auch möglich ist, steht nur die Option 'Kopie erstellten, in der alle möglichen Eigenschaften entfernt sind' zu Verfügung. Die ausgewählten Originaldateien mit ihren Metadaten bleiben also erhalten und zu jeder einzelnen Datei wird eine Kopie ohne Metadaten Verzeichnis erstellt. Wenn du kein Win7 hast, nützt dir das allerdings nichts.

Bei PDF-Dokumenten ist das etwas problematischer, weil es die Ausführung von Ghostscript erfordert. Einige Freeware-Tools ermöglichen zwar die Bearbeitung der Metatdaten, aber immer nur in einzelnen Dokumenten.

Gruß
Kalle

Answer 2

Habe leider noch Win XP.
Danke für die Antwort, Reinhard. Auf http://www.computing.net/answers/office/run-the-doc-inspector-and-delete-all-info/11614.html habe ich folgenden Code gefunden:

Option Explicit

Sub ClearDocs()
Dim wdd As Document
Dim intRetVal As Integer
Dim n As Integer

On Error GoTo ErrHnd

'turn off screen updating so we don't see
'all the documents opened and closed again
Application.ScreenUpdating = False

'set the file open dialog filters
Application.FileDialog(msoFileDialogOpen).Filters.Clear
Application.FileDialog(msoFileDialogOpen).Filters.Add _
Description:="Word documents (*.doc; *.docx)", _
Extensions:="*.doc;*.docx"

'setup and show the Open dialog box
With Application.FileDialog(msoFileDialogOpen)
.Title = "Select Documents to Clean"
'set start folder
.InitialFileName = "C:\temp\"
.AllowMultiSelect = True
'show the dialog box and get the button that was clicked
intRetVal = .Show
'check that user selected Open (-1) rather than Cancel (0)
If intRetVal = -1 Then
'iterate through the selected documents
For n = 1 To .SelectedItems.Count
'open document
Set wdd = Documents.Open(.SelectedItems(n))
'clear personal data from document
wdd.RemoveDocumentInformation (wdRDIAll)
'save and close document
wdd.Close SaveChanges:=True
Next n
End If
End With
'turn on screen updating
Application.ScreenUpdating = True
Exit Sub

'error handler
ErrHnd:
Err.Clear
'turn on screen updating
Application.ScreenUpdating = True
End Sub

Der Code funktioniert gut. Man kann aber nur eine Datei auswählen. Wie kriege ich es hin, dass ich Word-Dateien in Ordner und Unterordner bereinigen kann?
Ergänzung: auf www.webplain.de/foren/read.php?2,29672,29683 wird die Dateisuche so gelöst:

Dim fso As FileSystemObject
Dim fldOrdner As Folder, fldUnterordner As Folder, fleDatei As File
On Error GoTo FehlermerkeN
DoCmd.Hourglass True
Set fso = New FileSystemObject

If VerzeichniS = "" Then VerzeichniS = "C:\"

Set fldOrdner = fso.GetFolder(VerzeichniS) 'Ordner holen

If UVZ = True Then 'falls mit Unterverzeichnissen gesucht werden soll
For Each fldUnterordner In fldOrdner.SubFolders 'für jeden Unterordner...
DateiSuchE fldUnterordner.Path, Dateiname, DateiTyP, UVZ, Zeigen '...die Prozedur "Suche" erneut aufrufen
Next
End If

Vielleicht ist auch dieser Link : msdn.microsoft.com/en-us/library/cc974107(v=office.12).aspx eine Hilfe, dort wird die "SearchFolders procedure" benutzt

Private Sub SearchInFolder(ByVal Folderspec As String) ' auslesen aufrufen mit Ordnername
Dim StTyp As String
Dim FSO As Object
Dim FI As Object
Set FSO = CreateObject("Scripting.Filesystemobject")
If Not FSO.FolderExists(Folderspec) Then
MsgBox Folderspec & " ist nicht vorhanden."
Set FSO = Nothing
Exit Sub
End If
StTyp = "xls" ' Dateityp
'Dateien auslesen
For Each FI In FSO.GetFolder(Folderspec).Files ' Schleife über alle Dateien
'Dateityp feststellen
If UCase(FSO.GetExtensionName(FI)) = UCase(StTyp) Then
Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1) = FI 'anpassen
End If
Next
Set FSO = Nothing
End Sub