Consulting

Results 1 to 3 of 3

Thread: VBA to combine multiple word docs with comments and changes

  1. #1
    VBAX Regular
    Joined
    Oct 2016
    Posts
    45
    Location

    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:


    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

  2. #2
    VBAX Regular
    Joined
    Oct 2016
    Posts
    45
    Location
    *bump*

  3. #3

    A little late, but this works!

    Quote Originally Posted by h2whoa View Post
    *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****
    Last edited by SamT; 02-06-2021 at 10:17 AM.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •