Loop comparison macro

问题

I've done a text comparison macro using Word and I need to loop it so that it can compare between a few sets of documents. Any idea on how to do so? Here's my codes

   Dim template1 As Word.Document
   Dim spool1 As Word.Document
   Set template1 = Documents.Open("D:\Users\tmp4jj\Desktop\ComparisonTool\template1.docx")
   Set spool1 = Documents.Open("D:\Users\tmp4jj\Desktop\ComparisonTool\spool1.txt")
Application.CompareDocuments OriginalDocument:=Documents("template1.docx") _
    , RevisedDocument:=Documents("spool1.txt"), Destination:= _
    wdCompareDestinationNew, Granularity:=wdGranularityWordLevel, _
    CompareFormatting:=False, CompareCaseChanges:=True, CompareWhitespace:= _
    False, CompareTables:=True, CompareHeaders:=True, CompareFootnotes:=True, _
     CompareTextboxes:=True, CompareFields:=True, CompareComments:=True, _
    CompareMoves:=False, RevisedAuthor:="UOB", IgnoreAllComparisonWarnings:= _
    False
ActiveWindow.ShowSourceDocuments = wdShowSourceDocumentsBoth

and I also did a file counting macro, not sure if its required

    Dim FolderPath As String, path As String, count As Integer
FolderPath = "D:\Users\tmp4jj\Desktop\ComparisonTool"

path = FolderPath & "\*.docx"
path = FolderPath & "\*.txt"


FileName = Dir(path)

Do While FileName <> ""
   count = count + 1
    FileName = Dir()
Loop

MsgBox count & " : files found in folder"

Windows("Document1").Activate
Application.Run MacroName:="FileCount"
Application.Move Left:=-3, Top:=-3
Application.Run MacroName:="FileCount"
Application.Move Left:=-3, Top:=-3

回答1:

not entirely sure what you mean but you can select a batch of files to operate on using using the built-in file dialogs.

An example is:

Sub Example()
    Dim item, templateDoc As Document, compareDoc As Document

    'Get template file
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = False
        .Title = "Select template"
        If .Show = 0 Then Exit Sub
        Set compareDoc = Documents.Open(.SelectedItems(1))
    End With

    'Get files to batch process
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Title = "Select files to compare"
        If .Show = 0 Then Exit Sub
        For Each item In .SelectedItems
            'Do some stuff
            Set compareDoc = Documents.Open(item)
            CompareDocs templateDoc, compareDoc
            compareDoc.Close
        Next
    End With

End Sub
Sub CompareDocs(templateDoc As Document, compareDoc As Document)
    Application.CompareDocuments _
            OriginalDocument:=templateDoc, _
            RevisedDocument:=compareDoc, _
            Destination:=wdCompareDestinationNew, _
            Granularity:=wdGranularityWordLevel, _
            CompareFormatting:=False, _
            CompareCaseChanges:=True, _
            CompareWhitespace:=False, _
            CompareTables:=True, _
            CompareHeaders:=True, _
            CompareFootnotes:=True, _
            CompareTextboxes:=True, _
            CompareFields:=True, _
            CompareComments:=True, _
            CompareMoves:=False, _
            RevisedAuthor:="UOB", _
            IgnoreAllComparisonWarnings:=False
    ActiveWindow.ShowSourceDocuments = wdShowSourceDocumentsBoth
End Sub

来源：https://stackoverflow.com/questions/29767537/loop-comparison-macro