Ich habe mir ein Makro geschrieben,welches automatisch eine Fußzeile in alle Word-Dokumente eines Ordners einfügt.
Nun habe ich es so erweitert, dass er auch unterordner bearbeitet.
Das funktioniert auch, allerdings kommt, wenn er mit allem fertig ist ein
"Laufzeitfehler 5: Ungültiger Prozeduraufruf oder ungültiges Argument"
Der Fehler tritt beim Sub BearbeiteDateienInOrdnerRekursiv in der dritten Zeile von unten bei SubFolder = Dir auf.
Jemand eine Idee was ich dagegen machen kann?
Sub BearbeiteDateien()
Dim folderPath As String
Dim templatePathPortrait As String
Dim templatePathLandscape As String
Dim templateDocPortrait As Document
Dim templateDocLandscape As Document
Dim file As String
' Pfade anpassen
folderPath = "C:\Users\sbutz\Desktop\Test docx neu\" ' Passe den Pfad zum Ordner an, in dem sich die Dateien befinden
templatePathPortrait = "C:\Users\sbutz\Desktop\Fußzeile Hochformat.docx" ' Passe den Pfad zur Word-Datei mit der Fußzeile für Hochformat an
templatePathLandscape = "C:\Users\sbutz\Desktop\Fußzeile Querformat.docx" ' Passe den Pfad zur Word-Datei mit der Fußzeile für Querformat an
' Lade die Vorlagen
Set templateDocPortrait = Documents.Open(templatePathPortrait)
Set templateDocLandscape = Documents.Open(templatePathLandscape)
' Bearbeite Dateien im angegebenen Ordner
BearbeiteDateienInOrdnerRekursiv folderPath, templateDocPortrait, templateDocLandscape
' Schließe die Vorlagen
templateDocPortrait.Close SaveChanges:=False
templateDocLandscape.Close SaveChanges:=False
Set templateDocPortrait = Nothing
Set templateDocLandscape = Nothing
MsgBox "Fertig!"
End Sub
Sub BearbeiteDateienInOrdnerRekursiv(folderPath As String, templateDocPortrait As Document, templateDocLandscape As Document)
Dim file As String
Dim subFolder As String
' Bearbeite Dateien im aktuellen Ordner
file = Dir(folderPath & "\*.doc*")
Do While file <> ""
' Bearbeite Word-Dokument
BearbeiteWordDatei folderPath & "\" & file, templateDocPortrait, templateDocLandscape
file = Dir
Loop
' Durchsuche Unterordner
subFolder = Dir(folderPath & "\", vbDirectory)
Do While subFolder <> ""
If subFolder <> "." And subFolder <> ".." Then
If (GetAttr(folderPath & "\" & subFolder) And vbDirectory) = vbDirectory Then
' Bearbeite Dateien im Unterordner
BearbeiteDateienInOrdnerRekursiv folderPath & "\" & subFolder, templateDocPortrait, templateDocLandscape
End If
End If
subFolder = Dir ' Überprüfe, ob es weitere Unterordner gibt
If subFolder = "" Then Exit Do ' Beende die Schleife, wenn kein weiterer Unterordner gefunden wurde
Loop
End Sub
Sub BearbeiteWordDatei(filePath As String, templateDocPortrait As Document, templateDocLandscape As Document)
Dim doc As Document
Dim orientation As String
' Lade das Word-Dokument
Set doc = Documents.Open(filePath)
' Bestimme die Ausrichtung des Dokuments
orientation = doc.PageSetup.orientation
' Füge die entsprechende Fußzeile ein
If orientation = wdOrientPortrait Then
templateDocPortrait.Sections(1).Footers(wdHeaderFooterPrimary).Range.Copy
ElseIf orientation = wdOrientLandscape Then
templateDocLandscape.Sections(1).Footers(wdHeaderFooterPrimary).Range.Copy
End If
doc.Sections(1).Footers(wdHeaderFooterPrimary).Range.Paste
' Speichere das aktualisierte Dokument
doc.Save
doc.Close SaveChanges:=False
Set doc = Nothing
End Sub