フォーマットの変更を追跡せずにWord文書を比較する

Question

docxファイルを比較し、差分を保存するためのVBAルーチンを作成しました。デルタでTrackFormattingを無効にする必要がありますが、追加するには.trackFormatting = Falseは何もしません。 compareメソッドでは、CompareFormattingもfalseです。私はこれをどのようにするべきですか？

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が私に役立ちます。

1つのオプションは、比較を実行した後にすべての書式修正を受け入れる（または拒否する）ことです。 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から改変、無保証がそのまま供給される。）