Das hat 1a funktioniert, super! Schön, dass es Menschen wie dich noch gibt!

Eine Kleinigkeit fehlt mir nun noch, ist aber ein anderes Problem.
Ich habe das Makro so geschrieben, dass auch Dateien in einem Unterordner bearbeitet werden. Das macht er so lange, bis er keinen Unterordner mehr findet und geht dann aber leider auf Störung bei subFolder = Dir. Hab die Stelle gelb markiert. Hast du vll eine Idee wie ich diesen Fehler noch beheben kann? Ist aber eher ein Schönheitsfehler, da das Marko ja trotzdem bis zum Schluss durchläuft.

Das vollständige Makro:

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\"  ' 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(FileName:=templatePathPortrait, Visible:=False)
    Set templateDocLandscape = Documents.Open(FileName:=templatePathLandscape, Visible:=False)

        ' 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
    Dim rngTmp As Range, lngTmp As Long
    Dim template As Document
    Dim headFoot As HeaderFooter
    ' Lade das Word-Dokument
    Set doc = Documents.Open(filePath)
 
    ' Bestimme die Ausrichtung des Dokuments
    orientation = doc.PageSetup.orientation
     
    With doc.Sections(1).Footers(wdHeaderFooterPrimary)
        Select Case doc.PageSetup.orientation
            ' Füge die entsprechende Fußzeile ein
            Case wdOrientPortrait
                Set template = templateDocPortrait
            Case wdOrientLandscape
                Set template = templateDocLandscape
        End Select
         
        Set headFoot = template.Sections(1).Footers(wdHeaderFooterPrimary)
        headFoot.Range.Copy
        .Range.Paste
         
        ' Textlängen abgleichen
        Do While .Range.StoryLength > headFoot.Range.StoryLength
            Set rngTmp = .Range
            rngTmp.Start = rngTmp.End - 1
            lngTmp = rngTmp.StoryLength
            rngTmp.Delete
            If rngTmp.StoryLength = lngTmp Then
                Exit Do
            End If
        Loop
    End With
    With doc.PageSetup
            .FooterDistance = CentimetersToPoints(0.4)
    End With
    ' Speichere das aktualisierte Dokument
    doc.Save
    doc.Close SaveChanges:=False
    Set doc = Nothing
End Sub