Process indicator in a script

[coeurdange57]

Hi,

I create a script for comparing several versions of same documents in a folder. The script allows to create new reports with results.


Private Sub SummaryReportButton_Click()
Dim objDocA As Word.Document
Dim objDocB As Word.Document
Dim objDocC As Word.Document

Dim objFSO As Scripting.FileSystemObject
Dim objFolderA As Scripting.Folder
Dim objFolderB As Scripting.Folder
Dim objFolderC As Scripting.Folder

Dim colFilesA As Scripting.Files
Dim objFileA As Scripting.File

Dim i As Integer
Dim j As Integer

Set objFSO = New FileSystemObject
Set objFolderA = objFSO.GetFolder(ChooseFolder("Choose the folder with the original documents", ThisDocument.Path))
Set objFolderB = objFSO.GetFolder(ChooseFolder("Choose the folder with revised documents", ThisDocument.Path))
Set objFolderC = objFSO.GetFolder(ChooseFolder("Choose the folder for the comparisons documents", ThisDocument.Path))

Set colFilesA = objFolderA.Files

For Each objFileA In colFilesA
If objFileA.Name Like "*.docx" Then
Set objDocA = Documents.Open(objFolderA.Path & "\" & objFileA.Name)
Set objDocB = Documents.Open(objFolderB.Path & "\" & objFileA.Name)
Set objDocC = Application.CompareDocuments( _
OriginalDocument:=objDocA, _
RevisedDocument:=objDocB, _
Destination:=wdCompareDestinationNew)
objDocA.Close
objDocB.Close
On Error Resume Next
Kill objFolderC.Path & "\" & objFileA.Name
On Error GoTo 0
objDocC.SaveAs FileName:=objFolderC.Path & "\" & objFileA.Name
objDocC.Close SaveChanges:=False
End If
Next objFileA

End Sub


I would like to add a process indicator until that the task is finished. Could you please help me to implement that?

Many thanks in advance for your help.

Regards

[macropod]

Cross-posted at: https://www.excelforum.com/word-programming-vba-macros/1212392-word-vba-macro-for-comparing-word-reports-process-indicator.html
Please read VBA Express' policy on Cross-Posting in item 3 of the rules: http://www.vbaexpress.com/forum/faq.php?faq=new_faq_item#faq_new_faq_item3