MS Word (2010) Kopf+Fußzeile bei mehreren Dokumenten ändern

Hallo Zusammen,

ich habe hier ca. 100 Word Dateien liegen, bei denen ich in der Kopf und in der Fußzeile einen falschen Namen durch den richtigen ersetzten muss.

Ich schätze mal, dass man das mit nem Macro machen könnte.

Hat da zufällig jemand einen Code am Start ?

Code:

---

Sub ChangeMultipleDocXFiles()
Dim intResult As Integer
Dim strPath As String
Dim arrFiles() As String
Dim i As Integer


'Selection Dialog wird geoeffnet
intResult = Application.FileDialog(msoFileDialogFolderPicker).Show


'Ueberpruefung ob der Dialog abgebrochen wurde
If intResult <> 0 Then
    strPath = Application.FileDialog( _
        msoFileDialogFolderPicker).SelectedItems(1)
    arrFiles() = GetAllFilePaths(strPath)
    For i = LBound(arrFiles) To UBound(arrFiles)
        'Filter fuer .doc(x) Dateien sind nicht benoetigt, da ModifyFile Funktion nur Office-Dokumente bearbeitet
        Call ModifyFile(arrFiles(i))
    Next i
End If
End Sub






Private Sub ModifyFile(ByVal strPath As String)
Dim objDocument As Document
Set objDocument = Documents.Open(strPath)
objDocument.Activate


    'Kopfzeile + Fußzeile einfuegen
    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:="Test-Kopfzeile"
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
    Selection.TypeText Text:="Test-Fußzeile"
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument




objDocument.Close (True)
End Sub







Private Function GetAllFilePaths(ByVal strPath As String) _
As String()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Dim arrOutput() As String
ReDim arrOutput(1 To 1)
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder(strPath)
i = 1
'loops through each file in the directory and
'prints their names and path
For Each objFile In objFolder.Files
    ReDim Preserve arrOutput(1 To i)
    'print file path
    arrOutput(i) = objFile.Path
    i = i + 1
Next objFile
GetAllFilePaths = arrOutput
End Function

---

Stammt von http://software-solutions-online.com...ultiple-files/ wurde aber etwas umgeaendert und angepasst.