比较Word文档并创建带有修订的新文档 [英] Comparing Word documents and creating a new document with track changes

问题描述

我正在尝试在excel文档中创建vba脚本，以便比较Word文档版本并创建具有差异(修订记录)的摘要Word文档.

I'm trying to create a vba script in an excel document in order to compare Word documents versions and create summary Word documents with the differences (track changes).

这是我的脚本:

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

在保存带有修订的摘要文档时出现问题.该报告无法保存.我不知道该怎么解决.

I have a problem when saving the summary document with track changes. This report cannot be saved. I don't know exactly how to solve that.

请帮助我解决此问题，并在必要时优化此代码.

Could you please help me to solve this issue and optimize this code if necessary.

推荐答案

确保使用 Option Explicit 来查看问题.

我建议始终激活 Option Explicit :在VBA编辑器中，转到工具› 选项›

I recommend always to activate Option Explicit: In the VBA editor go to Tools › Options › Require Variable Declaration. So you have it activated automatically in all your new codes.

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

If you use late binding like Set WDApp = CreateObject("word.Application") all the Word enumeration constants like wdAlertsNone and wdCompareDestinationNew do not exist in Excel.

所以您要么需要

• 首先在Excel中定义它们
• 或使用早期绑定(通过在Extras> References菜单中设置对Word的引用)
• 或将所有wd常量替换为其特定的 Long 值.请参阅枚举的单词常数

• define them first in Excel
• or use early binding (by setting a reference to Word in the Extras > References menu)
• or replace all wd constants with their specific Long value. See Word Enumerated Constants

此外，您还需要设置WDDocC = WDApp.ActiveDocument ，因为Excel期望 ActiveDocument 在Excel中是某物，并且它不存在，仅在Word中存在.您需要指定您的意思是Word应用程序 WDApp 的 ActiveDocument .

Further you need to Set WDDocC = WDApp.ActiveDocument because Excel expects ActiveDocument to be something in Excel and there it doesn't exist, it only exists in Word. You need to specify that you mean the ActiveDocument of the Word application WDApp.

这篇关于比较Word文档并创建带有修订的新文档的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！