Microsoft Office Makro

Hallo zusammen,
Ich möchte ein Makro erstellen, das in allen Word-Dokumenten in einem Ordner eine Kopf-und eine Fusszeile einfügt.
Das einfügen der Kopf- und Fusszeile selber in einer Datei ist kein Problem. Doch das übernehmen für alle Dateien ist leider für mich nicht möglich. Folgenden Code habe ich bereits geschrieben, doch Application.Filesearch funktioniert meines Wissens seit Office 2007 nicht mehr. Daher brauche ich eine Alternative dazu.

Sub Makro1()
Dim anzdatei As Integer
Dim Pfad

Set fs = Application.FileSearch

'On Error GoTo Fehler
'hier kann auch ein fester Pfad eingegeben werden
Pfad = InputBox("Geben Sie den Pfad an", "Pfad")

'hier werden nur die insgesamt gefundenen Dateien ausgegeben
If Pfad = "" Then
MsgBox "Kein Pfad eingegeben!"
Exit Sub
End If

With fs
.NewSearch
.FileType = msoFileTypeWordDocuments
.LookIn = Pfad
.SearchSubFolders = True
'folgender Code wird nicht unbedingt gebraucht
If .Execute = 0 Then
MsgBox "Es wurden keine Dateien."
Exit Sub
End If
anzdatei = .FoundFiles.Count
End With

On Error Resume Next


For j = 1 To anzdatei
WordBasic.DisableAutoMacros 1
'If Err.Number <> 0 Then
Documents.Open fs.FoundFiles(j)

If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.TypeText Text:=vbTab & vbTab & "Joël Walker"
Selection.TypeParagraph
Selection.TypeText Text:=vbTab & vbTab
Selection.InsertDateTime DateTimeFormat:="dddd, d. MMMM yyyy", _
InsertAsField:=True, DateLanguage:=wdSwissGerman, CalendarType:= _
wdCalendarWestern, InsertAsFullWidth:=False
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
Application.Templates( _
"C:\Users\bfo\AppData\Roaming\Microsoft\Document Building Blocks\1031\15\Built-In Building Blocks.dotx" _
).BuildingBlockEntries("Einfache Zahl 1").Insert Where:=Selection.Range, _
RichText:=True
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

'Dokument wird gespeichert und geschlossen
ActiveDocument.Save
ActiveDocument.Close
'End If
Next j
WordBasic.DisableAutoMacros 0
MsgBox "Es wurden " & anzdatei & " Datei(en) neu gespeichert!"
End Sub

Ich würde mich sehr über Ihre Hilfe freuen.

Freundliche Grüsse und Besten Dank
Hanspeter92