Sub MergeDocs()
Dim rng As Range
Dim MainDoc As Document
Dim strFile As String, strFolder As String
Dim Count As Long
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Pick folder"
.AllowMultiSelect = False
If .Show Then
strFolder = .SelectedItems(1) & Application.PathSeparator
Else
Exit Sub
End If
End With
Count = 0
strFile = Dir$(strFolder & "*.doc") ' can change to .docx
Do Until strFile = ""
WordBasic.DisableAutoMacros 1
If Count = 0 Then
Set MainDoc = Documents.Add(Template:=strFolder & strFile)
Count = Count + 1
Else
Set rng = MainDoc.Range
With rng
.Collapse 0
If Count > 0 Then
.InsertBreak Type:=wdSectionBreakNextPage
.End = MainDoc.Range.End
.Collapse 0
End If
.InsertFile strFolder & strFile
End With
End If
strFile = Dir$()
WordBasic.DisableAutoMacros 0
Loop
MsgBox ("Files are merged")
lbl_Exit:
Exit Sub
End Sub