比较 Word 文档而不跟踪格式更改

Question

我已经编写了一个 VBA 例程来比较 docx 文件并保存差异。我需要在增量中停用 TrackFormatting 但添加 .trackFormatting = False 不会执行任何操作。在比较方法中，CompareFormatting 也是错误的！我应该怎么做？

Sub ProduceDeltas()
   Dim strFolderA As String
   Dim strFolderB As String
   Dim strFolderC As String
   Dim strFileSpec As String
   Dim strFileName As String
   Dim objDocA As Word.Document
   Dim objDocB As Word.Document
   Dim objDocC As Word.Document
   Dim dc As Word.Document
   Dim FldrPickerInputA As FileDialog
   Dim FldrPickerInputB As FileDialog
   Dim FldrPickerOutput As FileDialog
  Application.ScreenUpdating = False
  Set FldrPickerInputA = Application.FileDialog(msoFileDialogFolderPicker)
  Set FldrPickerInputB = Application.FileDialog(msoFileDialogFolderPicker)
  Set FldrPickerOutput = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPickerInputA
  .Title = "Choose first file: "
  .AllowMultiSelect = False
    If .Show <> -1 Then GoTo NextCode
    strFolderA = .SelectedItems(1) & "\"
   End With
   With FldrPickerInputB
  .Title = "Choose second file: "
  .AllowMultiSelect = False
    If .Show <> -1 Then GoTo NextCode
    strFolderB = .SelectedItems(1) & "\"
   End With
  With FldrPickerOutput
  .Title = "Choose output file: "
  .AllowMultiSelect = False
    If .Show <> -1 Then GoTo NextCode
    strFolderC = .SelectedItems(1) & "\"
 End With  

 NextCode:
 strFolderA = strFolderA
 strFolderB = strFolderB
 strFolderC = strFolderC
 If strFolderA = "" Then GoTo ResetSettings
 strFileSpec = "*.docx"
 strFileName = Dir(strFolderA & strFileSpec)
 Do While strFileName <> vbNullString
 Set objDocA = Documents.Open(strFolderA & strFileName)
 Set objDocB = Documents.Open(strFolderB & strFileName)
 If objDocA.TablesOfContents.Count = 1 Then _
   objDocA.TablesOfContents(1).Update
 If objDocB.TablesOfContents.Count = 1 Then _
   objDocB.TablesOfContents(1).Update
 Set dc = Application.CompareDocuments(objDocA, objDocB,           wdCompareDestinationNew, _
   Granularity:=wdGranularityWordLevel, _
   CompareFormatting:=False, RevisedAuthor:="IQTIG",        CompareFootnotes:=False,   CompareHeaders:=False)

dc.TrackFormatting = False
objDocA.Save
objDocB.Save
objDocA.Close
objDocB.Close

If dc.TablesOfContents.Count = 1 Then _
 dc.TablesOfContents(1).Update

dc.SaveAs strFolderC & strFileName
dc.Close SaveChanges:=False
strFileName = Dir
Loop

Set objDocA = Nothing
Set objDocB = Nothing

ResetSettings: 
Application.ScreenUpdating = True
End Sub

Answer 1

哪个版本的 Word？在 Word 2013 上，CompareFormatting:=False 适合我。

一种选择是在运行比较后接受（或拒绝）所有格式修订。在 dc.SaveAs 之前插入以下内容：

dim oRevision as Revision
For Each oRevision In dc.StoryRanges(wdMainTextStory).Revisions
    If (oRevision.Type<> wdRevisionInsert) and (oRevision.type <> wdRevisionDelete) then
        oRevision.Accept    ' or .Reject
    End If
Next oRevision

（代码由 Lene Fredborg 从 ExtractTrackedChangesToNewDoc 修改而来，按原样提供，不提供任何保证。）

比较 Word 文档而不跟踪格式更改

Compare Word documents without tracking formatting changes

vba

ms-word

docx