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

amadese57

New Member
Joined
Apr 8, 2021
Messages
4
Office Version
  1. 365
Platform
  1. Windows
Hi,

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, _
        IgnoreAllComparisonWarnings:=False
        
        WDDocA.Close
        WDDocB.Close
        '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

NextCode:
    ChooseFolder = sItem
    Set fldr = Nothing
End Function
Code:

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

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.

Watch MrExcel Video

Forum statistics

Threads
1,130,310
Messages
5,641,450
Members
417,210
Latest member
rins

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
Top