循环比较宏

时间:2015-04-21 09:01:34

标签: vba ms-word word-vba

我已经使用Word完成了文本比较宏,我需要将其循环,以便可以在几组文档之间进行比较。有关如何这样做的任何想法? 这是我的代码

   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

我还做了一个文件计数宏,不知道是否需要

    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 个答案:

答案 0 :(得分:0)

不完全确定您的意思,但您可以使用内置文件对话框选择要使用的一批文件。

一个例子是:

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