Compare Word documents without tracking formatting changes - vba

Question

I have written a VBA routine for comparing docx files and saving the delta. I need to deactivate TrackFormatting in the delta but adding .trackFormatting = False does not do anything. In the compare method the CompareFormatting is false as well! How should I do this?
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

Which version of Word? On Word 2013, CompareFormatting:=False works for me.
One option is to accept (or reject) all formatting revisions after running the comparison. Before dc.SaveAs, insert the following:
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
(code modified from ExtractTrackedChangesToNewDoc by Lene Fredborg, supplied as-is with no warranty.)