Habe den Fehler gefunden...
Für Word mit .docx Format benötige ich FormatDocumentDefault, das Funktioniert dann bei .doc und .docx.
Mit FormatDocument hat es nur bei .doc Funktioniert
' Worddatei ohne Passwort schreiben
ActiveDocument.SaveAs2 FileName:=Zielverzeichnis & "" & DatNam, FileFormat:=wdFormatDocumentDefault, _
LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
False
Jetzt das Funktionierende Makro für .doc und .docx Formate:
Sub WordDateienEntsperren()
' Entfernt das Passwort von allen Word-Dateien aus Quelle und
' schreibt die Worddateien ohne Passwort nach Ziel
Const Quellverzeichnis = "DateiPfad"
Const Zielverzeichnis = "DateiPfad"
Const MyPasswort = "Passwort"
Dim DatNam As String
DatNam = Dir(Quellverzeichnis & "\*.doc*") '1. Dateinamen holen
Do Until DatNam = "" 'Alle Files im VZ abklappern
' Worddatei mit Passwort öffnen
Documents.Open FileName:=Quellverzeichnis & "\" & DatNam, ConfirmConversions:=False, ReadOnly:= _
False, AddToRecentFiles:=False, PasswordDocument:=MyPasswort, PasswordTemplate:= _
"", Revert:=False, WritePasswordDocument:=MyPasswort, WritePasswordTemplate:= _
"", Format:=wdOpenFormatAuto
' Worddatei ohne Passwort schreiben
ActiveDocument.SaveAs2 FileName:=Zielverzeichnis & "\" & DatNam, FileFormat:=wdFormatDocumentDefault, _
LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
False
' Dokument schließen
ActiveDocument.Close
' nächste Datei holen
DatNam = Dir
Loop
End Sub
|