VB Script to compare word documents

[anbillava]

I have two locations, one has the old files and the other one has the revised files. I am trying to create a vb macro to compare each of these word document and save them in a new location.


I am not able to succeed can somebody help me.
Sub Macro1()
'
' Macro1 Macro
'


Set objWord = CreateObject("Word.Application")
objWord.DisplayAlerts = wdAlertsNone
objWord.Visible = True

Set ORIGINAL = objWord.Documents.Open("S:\Data Management\Oncology Data Management\DataOps\Global Projects\RTF Comparison\Input\old\Profile_10011002.rtf", , False)
Set REVISED = objWord.Documents.Open("S:\Data Management\Oncology Data Management\DataOps\Global Projects\RTF Comparison\Input\new\Profile_10011002.rtf", , False)

Application.CompareDocuments OriginalDocument:=ORIGINAL, _
RevisedDocument:=REVISED, _
Destination:=wdCompareDestinationNew

'ORIGINAL.Close False
'REVISED.Close False
'objWord.Quit


End Sub

 

[Norie]

Here you should be using objWord instead of Application.

Application.CompareDocuments OriginalDocument:=ORIGINAL, _
RevisedDocument:=REVISED, _
Destination:=wdCompareDestinationNew

Click to see how the code should look.

objWord.CompareDocuments OriginalDocument:=ORIGINAL, _
RevisedDocument:=REVISED, _
Destination:=wdCompareDestinationNew

 

[anbillava]

I am able to improvise my code as below. However your response to change to Objword does not really make any difference. Thank you very much for your response.

I am getting an prompt window after the comparison saying the "table in the document has become corrupted". This is annoying. Is there a way I can bypass those prompt. I appreciate your help.

Sub CompareAllFiles()
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
strFolderA = InputBox("Enter path to base documents:")
strFolderA = strFolderA & "\"
strFolderB = InputBox("Enter path to new documents:")
strFolderB = strFolderB & "\"
strFolderC = InputBox("Enter path for document comparisons to be saved:")
strFolderC = strFolderC & "\"
strFileSpec = "*.rtf"
strFileName = Dir(strFolderA & strFileSpec)
'MsgBox strFolderA
Do While strFileName <> vbNullString


Set objDocA = Documents.Open(strFolderA & strFileName)
Set objDocB = Documents.Open(strFolderB & strFileName)
Application.CompareDocuments _
OriginalDocument:=objDocA, _
RevisedDocument:=objDocB, _
Destination:=wdCompareDestinationNew, _
IgnoreAllComparisonWarnings:=False


objDocA.Close
objDocB.Close
Set objDocC = ActiveDocument
objDocC.SaveAs FileName:=strFolderC & strFileName
'objDocC.Close SaveChanges:=False
strFileName = Dir

Loop
Set objDocA = Nothing
Set objDocB = Nothing
End Sub

 

[Norie]

You still aren't using objWord, and it also needs to be added here.

Set objDocA = Documents.Open(strFolderA & strFileName)
Set objDocB = Documents.Open(strFolderB & strFileName)

Documents.Open should be objWord.Docuements.Open.