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

[amadese57]

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:

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

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?