Dein Ansatz ist scho gut :-)

In dieser Variante werden a lle Pfade in einem Array zurück geliefert, die im "BearbeiteDateienInOrdnerRekursiv" nacheinander abgearbeitet werden:

Option Explicit

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
    Dim subfolders As Variant
    Dim folders As Variant
    
    folders = GetSubdirectoriesArray(folderPath)
    
    For Each subfolders In folders
        ' Bearbeite Dateien im aktuellen Ordner
        file = Dir(subfolders & "\" & "*.doc*")
        
        Do While file <> ""
            ' Bearbeite Word-Dokument
            BearbeiteWordDatei subfolders & "\" & file, templateDocPortrait, templateDocLandscape
            file = Dir
        Loop
    Next subfolders
 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
    Application.ScreenUpdating = False
    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
    Application.ScreenUpdating = True
End Sub


Function GetSubdirectoriesArray(ByVal folderPath As String) As Variant
    Dim subfolders() As String
    Dim subfolder As Object
    Dim subfolderPath As String
    Dim i As Integer

    ' \-Zeichen am Ende des Pfades entfernen
    If Right(folderPath, 1) = "\" Then
        folderPath = Left(folderPath, Len(folderPath) - 1)
    End If

    ' Überprüfe, ob der Pfad existiert
    If Dir(folderPath, vbDirectory) = "" Then
        MsgBox "Der angegebene Pfad existiert nicht.", vbExclamation
        Exit Function
    End If

    ' Durchsuche die Unterverzeichnisse, füge den Ausgangspfad hinzu
    ReDim subfolders(0)
    subfolders(0) = folderPath
    i = 1

    With CreateObject("Scripting.FileSystemObject").GetFolder(folderPath)
        For Each subfolder In .subfolders
            subfolderPath = subfolder.Path

            ' Rekursiver Aufruf für Unterverzeichnisse
            Dim subfolderSubdirectories As Variant
            subfolderSubdirectories = GetSubdirectoriesArray(subfolderPath)

            If Not IsEmpty(subfolderSubdirectories) Then
                Dim subfolderCount As Integer
                subfolderCount = UBound(subfolderSubdirectories) - LBound(subfolderSubdirectories) + 1
                ReDim Preserve subfolders(i - 1 + subfolderCount)
                Dim j As Integer
                For j = LBound(subfolderSubdirectories) To UBound(subfolderSubdirectories)
                    subfolders(i) = subfolderSubdirectories(j)
                    i = i + 1
                Next j
            End If
        Next subfolder
    End With

    GetSubdirectoriesArray = subfolders
End Function

Die Funktion GetSubdirectoriesArray wurde mit Hilfe des Obline Services chat.openai.com entwickelt. Die chat.openai.com liefert gute Ansätze, jedoch sind hier und da des öfteren Fehler enthalten.

Wie auch immer - Die Funktion GetSubdirectoriesArray liefrt in der vorliegenden Version immer alle Unterpfade inkl. den übergebenen Pfades zurück.
Diese Funktion kann durchaus auch in anderen Projekten verwendet werden.