Word-Dokumente zusammenfassen

Mein aktuelles Problem: Mehrere Word-Dokumente sollten in einem neuem Dokument zusammengefasst werden.

Zwei mögliche Lösungen bieten sich an:
1. Neues Word-Dokument erstellen, Einfügen, Objekt, „Text aus Datei”
2. Ein Makro erstellen, dass alle Dateien in einem bestimmten Ordner öffnet und in eine neue Datei einfügt (ohne Beachtung einer eventuell gewünschten Reihenfolge).

Da mir Variante 2 besser gefällt (😊) folgt der verwendete code:

Sub ConcatenateAllWordFiles()
Dim mypath
mypath = BrowseFolder("Verzeichnis Wählen")
Set fso = CreateObject("Scripting.FileSystemObject")
Set Folder = fso.GetFolder(mypath)
Set allFiles = Folder.Files
Set newDoc = Documents.Add
For Each file In allFiles
If Right(file, 5) = ".docx" Then
Documents.Open FileName:=file.Path
current = ActiveDocument.Name
Selection.WholeStory
Selection.Copy
Documents(current).Close
newDoc.Activate
Selection.Paste
Selection.EndKey Unit:=wdLine
End If
Next
End Sub
Function BrowseFolder(Title As String, _
Optional InitialFolder As String = vbNullString, _
Optional InitialView As Office.MsoFileDialogView = _
msoFileDialogViewList) As String
Dim V As Variant
Dim InitFolder As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = Title
.InitialView = InitialView
If Len(InitialFolder) > 0 Then
If Dir(InitialFolder, vbDirectory) <> vbNullString Then
InitFolder = InitialFolder
If Right(InitFolder, 1) <> "\" Then
InitFolder = InitFolder & "\"
End If
.InitialFileName = InitFolder
End If
End If
.Show
On Error Resume Next
Err.Clear
V = .SelectedItems(1)
If Err.Number <> 0 Then
V = vbNullString
End If
End With
BrowseFolder = CStr(V)
End Function

Das ist natürlich nicht alles meine alleinige Idee, die Grobe Vorlage war dies.
Die BrowseFolder-Funktion habe ich komplett „gefunden”…