VBA to combine multiple word docs with comments and changes

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:

Code:

---

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

---

*bump* :hi:

Quote:

---

Originally Posted by h2whoa

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

Code:

---

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

---

Code:

---

Sub MergeDocument(sPath As String)
    Application.ScreenUpdating = False
    ActiveDocument.Merge FileName:=sPath, _
    MergeTarget:=wdMergeTargetSelected, DetectFormatChanges:=True, _
    UseFormattingFrom:=wdFormattingFromPrompt, AddToRecentFiles:=False
End Sub

---

Code:

---

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