Stammt von http://software-solutions-online.com...ultiple-files/ wurde aber etwas umgeaendert und angepasst.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