比较 Word 文档并创建带有跟踪更改的新文档

问题描述

我正在尝试在 Excel 文档中创建一个 vba 脚本，以便比较 Word 文档版本并创建具有差异（跟踪更改）的摘要 Word 文档。

这是我的脚本：

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
    Debug.Print objFolderAPath
    
    Set objFolderB = objFSOB.GetFolder(ChooseFolder("Choose the folder with revised documents"))
    objFolderBPath = objFolderB.Path
    Debug.Print objFolderBPath
    
    Set objFolderC = objFSOC.GetFolder(ChooseFolder("Choose the folder for the comparisons documents"))
    objFolderCPath = objFolderC.Path
    Debug.Print objFolderCPath


    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


    PathFileA = objFolderA.Path & "\" & objFileA.Name
    Debug.Print PathFileA
    PathFileB = objFolderB.Path & "\" & objFileA.Name
    Debug.Print PathFileB
    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 = WDApp.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


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

保存带有跟踪更改的摘要文档时遇到问题。无法保存此报告。我不知道如何解决这个问题。

您能否帮我解决这个问题并在必要时优化此代码。

解决方法

确保您使用 Option Explicit 查看您的问题。

我建议始终激活 Option Explicit：在 VBA 编辑器中转到 Tools › Options › Require Variable Declaration .因此，您已在所有新代码中自动激活它。

如果您使用像 Set WDApp = CreateObject("word.Application") 这样的后期绑定，则 Excel 中不存在所有 Word 枚举常量（例如 wdAlertsNone 和 wdCompareDestinationNew）。

所以要么你需要

• 首先在 Excel 中定义它们
• 或使用早期绑定（通过在 Extras > References 菜单中设置对 Word 的引用）
• 或将所有 wd 常量替换为其特定的 Long 值。见Word Enumerated Constants

此外，您还需要 Set WDDocC = WDApp.ActiveDocument，因为 Excel 期望 ActiveDocument 是 Excel 中的某个东西，而它并不存在，它只存在于 Word 中。您需要指定您指的是 Word 应用程序 ActiveDocument 的 WDApp。