Originally Posted by
h2whoa
*bump*
Greetings! I suspect the original folks have moved on from this requirement, but I had to cook something up for lack of finding a script floating around out there. Hopefully someone else out there will find it useful, too
If you step through the code, you'll see it saves a copy of the results in the merge folder selected by the user, then closes everything out.
BTW, it will be necessary to enable the Microsoft Scripting Runtime reference library in the VBA editor (Tools menu --> References --> Microsoft Scripting Runtime) Hope it helps!
****begin****
Sub MergeDocs()
Dim sMergePath As String
Dim strFile As String
Dim strTime As String
Dim i As Long
sMergePath = MergeFolder
If sMergePath = vbNullString Then Exit Sub
strFile = Dir$(sMergePath & "*.docx")
While strFile <> ""
MergeDocument sMergePath & strFile
i = i + 1
strFile = Dir$()
Wend
MsgBox ("Processed " & i & " documents. Check merge folder for file.")
Application.DisplayAlerts = False
strTime = Format(Now, "yyyymmdd" & "hhmmss")
ActiveDocument.SaveAs FileName:=ActiveDocument.Path & "" & "Combined Comments - " & strTime, FileFormat:=wdFormatDocumentDefault
Application.Documents.Close
Application.Quit
End Sub
Sub MergeDocument(sPath As String)
Application.ScreenUpdating = False
ActiveDocument.Merge FileName:=sPath, _
MergeTarget:=wdMergeTargetSelected, DetectFormatChanges:=True, _
UseFormattingFrom:=wdFormattingFromPrompt, AddToRecentFiles:=False
End Sub
Function MergeFolder() As String
MergeFolder = vbNullString
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select the folder containing files to be merged."
If .Show = -1 Then
MergeFolder = .SelectedItems(1) & Chr(92)
End If
End With
End Function
****end****