PDA

View Full Version : [SOLVED:] VBA to combine multiple word docs with comments and changes



h2whoa
10-25-2016, 01:57 AM
Hi all,

I'm looking for a VBA macro that will allow me to merge tracked changes and comments from multiple authors into a single document. For example: I’ve sent a document to 20 people by email. 15 of them come back with tracked changes and/or comments. Instead of trying to work with all the different versions, I want to collate all of the revisions and comments into a single version of the document, showing who made what changes.

Now, I did find a post from a while back that has offered a code that more or less does the job, however, it ends up creating multiple open documents with different levels of comments and changes merged, making version control difficult. So I'm just wondering if there is a way to modify the code to combine all of the comments and tracked changes into a single open document?

Thanks so much!

The code I have been using is:



Option Explicit

Sub MergeDocuments()
Dim iFile As Integer
Dim sMergePath As String
Dim strFile As String
Dim i As Long
sMergePath = MergeFolder
If sMergePath = vbNullString Then Exit Sub

strFile = Dir$(sMergePath & "*.doc")
While strFile <> ""
MergeDocument sMergePath & strFile
i = i + 1
strFile = Dir$()
Wend
MsgBox ("The code finished merging: " & i & " documents")
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 of the merge files"
If .Show = -1 Then
MergeFolder = .SelectedItems(1) & Chr(92)
End If
End With
End Function

h2whoa
11-01-2016, 04:30 AM
*bump* :hi:

Jeff Jacques
02-06-2021, 02:01 AM
*bump* :hi:

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****