Excel vba for creating a summary word document from the comparison of 2 word documents


New Member
Apr 8, 2021
Office Version
  1. 365
  1. Windows

I created a vba script in Excel in order to create a word document as summary of comparison of 2 word documents.

Here my script:

VBA Code:
Option Explicit

Private Sub ButtonSummaryReport_Click()
    'Initialize the progressbar and the label
    Dim k As Integer
    Dim filesNumber As Integer
    Dim i As Integer
    Dim j As Integer
    Dim objFolderAPath As String
    Dim objFolderBPath As String
    Dim objFolderCPath As String
    Dim FileName As String
    Dim WDApp As Object 'Word.Application
    Dim WDDocA As Object 'Word.Document
    Dim WDDocB As Object 'Word.Document
    Dim WDDocC As Object 'Word.Document
    'Declare variable
    Dim objFSOA As Object
    Dim objFSOB As Object
    Dim objFSOC As Object
    Dim objFolderA As Object
    Dim objFolderB As Object
    Dim objFolderC As Object
    Dim colFilesA As Object
    Dim objFileA As Object
    Dim PathFileA As String
    Dim PathFileB As String
    Dim PathFileC As String
    Dim wordapp
    k = 0
    Me.LabelSummaryReport.Caption = "Please wait..."
    Me.ProgressBarSummaryReport.Value = k
    'Create an instance of the FileSystemObject
    Set objFSOA = CreateObject("Scripting.FileSystemObject")
    Set objFSOB = CreateObject("Scripting.FileSystemObject")
    Set objFSOC = CreateObject("Scripting.FileSystemObject")
    'Select the path for the 3 folders
    Set objFolderA = objFSOA.GetFolder(ChooseFolder("Choose the folder with the original documents"))
    objFolderAPath = objFolderA.Path
    Set objFolderB = objFSOB.GetFolder(ChooseFolder("Choose the folder with revised documents"))
    objFolderBPath = objFolderB.Path
    Set objFolderC = objFSOC.GetFolder(ChooseFolder("Choose the folder for the comparisons documents"))
    objFolderCPath = objFolderC.Path

    Set colFilesA = CreateObject("Scripting.FileSystemObject")
    Set objFileA = CreateObject("Scripting.FileSystemObject")
    Set colFilesA = objFolderA.Files
    'Turn off DisplayAlerts
    Application.DisplayAlerts = wdAlertsNone
    'Number of files in the folder
    filesNumber = objFolderA.Files.Count
    Me.LabelSummaryReport.Caption = "The comparison process starts..."
    For Each objFileA In colFilesA

    'Path for the files
    PathFileA = objFolderA.Path & "\" & objFileA.Name
    PathFileB = objFolderB.Path & "\" & objFileA.Name
    PathFileC = objFolderC.Path & "\" & objFileA.Name
    Debug.Print PathFileC
    If objFileA.Name Like "*.docx" Then
        'Creating object of the word application
        Set WDApp = CreateObject("word.Application")
        'Making visible the word application
        WDApp.Visible = True
        'Opening the required word document
        Set WDDocA = WDApp.Documents.Open(PathFileA) 

        'Opening the required word document
        Set WDDocB = WDApp.Documents.Open(PathFileB)
        WDApp.CompareDocuments _
        OriginalDocument:=WDDocA, _
        RevisedDocument:=WDDocB, _
        Destination:=wdCompareDestinationNew, _
        'On Error Resume Next
        'Kill objFolderC.Path & "\" & objFileA.Name
        'On Error GoTo 0
        'Turn off DisplayAlerts
        WDApp.DisplayAlerts = wdAlertsNone
        Set WDDocC = ActiveDocument
        WDDocC.SaveAs FileName:=PathFileC
        WDDocC.Close SaveChanges:=True
    End If

        'Update of the progressbar and the label
        k = k + 1
        Me.LabelSummaryReport.Caption = k * 100 / filesNumber & "% Completed"
        Me.ProgressBarSummaryReport.Value = k * 100 / filesNumber
    Next objFileA
    Me.LabelSummaryReport.Caption = "The process is complete. Comparison reports have been created."
End Sub

'Fucntion for choosing a folder on the computer
Function ChooseFolder(title) As String
    Dim fldr As FileDialog
    Dim sItem As String

    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .title = title
        .AllowMultiSelect = False
        .InitialFileName = strPath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With

    ChooseFolder = sItem
    Set fldr = Nothing
End Function

I have a problem for saving the final summary document. (the message is "Object required" at the step: Set WDDocC = ActiveDocument).
Besides after closing the 2 documents A and B to compare, my summary document is also closed and cannot be saved.

Could you please help me with that?

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Latest member

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back