#1
|
|||
|
|||
VBA macro issue
I am having trouble, with vba macro that I got online to compare two word documents (RTF) files. However I am running an issue can you please help to correct the issue in the file?
Reference VBA MAcro 1: https://www.pharmasug.org/proceeding...020-AD-055.pdf VBA macro Code Sub Compare() Dim wd As Word.Application Dim odoc As Word.Document Dim rdoc As Word.Document Dim strOPath As String Dim strRPath As String Dim strCPath As String Dim strORTFfile As String Dim ofiles() As String Dim i As Integer strOPath = InputBox("Please enter the folder of original documents:") strRPath = InputBox("Please enter the folder of revised documents:") strCPath = InputBox("Please enter the folder to save the comparison: ") Set wd = GetObject(, "Word.Application") If wd Is Nothing Then Set wd = CreateObject("Word.Application") End If ReDim Preserve ofiles(0) strORTFfile = Dir(strOPath & "" & ("*.rtf"), vbNormal) Do While strORTFfile <> Empty ReDim Preserve ofiles(UBound(ofiles) + 1) ofiles(UBound(ofiles)) = strORTFfile strORTFfile = Dir Loop For i = 1 To UBound(ofiles) If Dir(strRPath & "" & ofiles(i)) <> Empty Then Set odoc = wd.Documents.Open(strOPath & "" & ofiles(i)) Set rdoc = wd.Documents.Open(strRPath & "" & ofiles(i)) Set ndoc = Application.CompareDocuments(OriginalDocument:=odo c, _ RevisedDocument:=rdoc, _ Destination:=wdCompareDestinationNew, _ Granularity:=wdGranularityWordLevel, _ CompareFormatting:=True, _ CompareCaseChanges:=True, _ CompareWhitespace:=True, _ CompareTables:=True, _ CompareHeaders:=True, _ CompareFootnotes:=True, _ CompareTextboxes:=True, _ CompareFields:=True, _ CompareComments:=True, _ CompareMoves:=True, _ RevisedAuthor:="Merck & Co., Inc.", _ IgnoreAllComparisonWarnings:=False) ActiveWindow.ShowSourceDocuments = wdShowSourceDocumentsNone ActiveWindow.Visible = False ofiles(i) = Replace(ofiles(i), Chr(13), "") ndoc.SaveAs2 FileName:=strCPath & "" & ofiles(i),_ FileFormat:=wdFormatRTF, LockComments:=False, _ Password:="", AddToRecentFiles:=True, WritePassword:="",_ ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _ SaveNativePictureFormat:=False, SaveFormsData:=False, _ SaveAsAOCELetter:=False, CompatibilityMode:=0 odoc.Close SaveChanges = False rdoc.Close SaveChanges = False ndoc.Close SaveChanges = False End If Next End Sub End of VBA Macro Code thanks |
#2
|
|||
|
|||
Hi, there are some errors in the posted code, but they are not the cause of the code's malfunction. It will take time to find it out.
|
#3
|
|||
|
|||
This works for me. Notes: I replaced rtf with docx; The files to compare must have identical names; The full paths to the folders with the ending backslashes must be entered, which I have included as examples in inputboxes.
Code:
Sub Compare_2_Fldrs() 'Compare similarly-named docs in two folders. Dim wd As word.Application Dim odoc As word.Document Dim rdoc As word.Document Dim strOPath As String Dim strRPath As String Dim strCPath As String Dim strORTFfile As String Dim ofiles() As String Dim i As Integer strOPath = InputBox("Enter the full path to the folder with original documents:" _ & vbCr & "e.g.:" & vbCr & "D:\Orig_Fldr\") strRPath = InputBox("Enter the full path to the folder with revised documents:" _ & vbCr & "e.g.:" & vbCr & "D:\Revsd_Fldr\") strCPath = InputBox("Enter the full path to the folder to save the comparisons in:" _ & vbCr & "e.g.:" & vbCr & "D:\Result_Fldr\") Set wd = GetObject(, "Word.Application") If wd Is Nothing Then Set wd = CreateObject("Word.Application") End If ReDim Preserve ofiles(0) strORTFfile = Dir(strOPath & "" & ("*.docx"), vbNormal) Do While strORTFfile <> Empty ReDim Preserve ofiles(UBound(ofiles) + 1) ofiles(UBound(ofiles)) = strORTFfile strORTFfile = Dir Loop For i = 1 To UBound(ofiles) If Dir(strRPath & "" & ofiles(i)) <> Empty Then Set odoc = wd.Documents.Open(strOPath & "" & ofiles(i)) Set rdoc = wd.Documents.Open(strRPath & "" & ofiles(i)) Set nDoc = Application.CompareDocuments(OriginalDocument:=odoc, _ RevisedDocument:=rdoc, _ Destination:=wdCompareDestinationNew, _ Granularity:=wdGranularityWordLevel, _ CompareFormatting:=True, _ CompareCaseChanges:=True, _ CompareWhitespace:=True, _ CompareTables:=True, _ CompareHeaders:=True, _ CompareFootnotes:=True, _ CompareTextboxes:=True, _ CompareFields:=True, _ CompareComments:=True, _ CompareMoves:=True, _ RevisedAuthor:="Merck & Co., Inc.", _ IgnoreAllComparisonWarnings:=False) ActiveWindow.ShowSourceDocuments = wdShowSourceDocumentsNone ActiveWindow.Visible = False ofiles(i) = Replace(ofiles(i), Chr(13), "") nDoc.SaveAs2 fileName:=strCPath & "" & ofiles(i), _ FileFormat:=wdFormatdocx, LockComments:=False, _ Password:="", AddToRecentFiles:=True, WritePassword:="", _ ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _ SaveNativePictureFormat:=False, SaveFormsData:=False, _ SaveAsAOCELetter:=False, CompatibilityMode:=0 odoc.Close SaveChanges = False rdoc.Close SaveChanges = False nDoc.Close SaveChanges = True End If Next i End Sub |
#4
|
|||
|
|||
Thank you very much for looking into this; however, I have a question since you added extra code ( I am new to vba).
Example: My path is "D:\destop\Folder1" In the below code do I need to replace this code with what text? strOPath = InputBox("Enter the full path to the folder with original documents:" _ & vbCr & "e.g.:" & vbCr & "D:\Orig_Fldr") thank you very much |
#5
|
|||
|
|||
VBAlearn, the added lines of code are examples. You should enter: D:\destop\Folder1\ and the full paths to the existing Revised folder and Result folder in the respective inputboxes. Be sure to enter the ending backslashes! The macro compares ALL docx files found in the Original folder with the same number of files of the same names in the Revised folder and saves the result files in the Result folder. The folder names can be anything but the file names in the folders entered as Original and Revised folders must be identical. If you want to compare only one file with its new version, put that file in the Original folder and the new-version file in the Revised folder (no other files in those folders!). I hope, my explanation is clear.
|
#6
|
|||
|
|||
I am still not able to understand. I'm very sorry about that. Also, I replaced the 'Docx' with "rtf" since my file is 'RTF'. When I ran the program, I got a pop-up box to enter some information, but I was not sure what to do. unfortunately I was not able to attach the pop-up image
I have replaced my paths here. Can you please tell me if I need to do differently? ***VBA code**** ...................... .......... strOPath = InputBox("D:\OneDrive - MSOPROD\test\Desktop\Old\Tables2") strRPath = InputBox("D:\OneDrive - MSOPROD\test\Desktop\New\Tables2") strCPath = InputBox("D:\OneDrive - MSOPROD\test\Desktop\New") ............... ........................... *********END******** |
#7
|
|||
|
|||
update : 10-04-2023 11.05 PM EST: For some reason it working on Docx files but not working on RTF files ( replaced the 'DOCX' with 'RTF'
|
#8
|
|||
|
|||
Hi! If the files to compare are Tables2 and these files are the only ones in the respective folders, then correct code lines will be:
strOPath = "D:\OneDrive - MSOPROD\test\Desktop\Old" strRPath = "D:\OneDrive - MSOPROD\test\Desktop\New" strCPath = "D:\OneDrive - MSOPROD\test\Desktop\Result" Note that the Result folder should have a name different from other two folders. PS. I didn't check the code on rtf files. I think it should work, but if it doesn't I'd save the files as docx (it's simple and easy) and then run the code. Last edited by vivka; 10-05-2023 at 12:48 PM. |
#9
|
|||
|
|||
Thank you for the reply. It worked for the 'Docx' files but not the RTF files for Some reason ( I replaced 'Docx' with 'RTF' in the code). Thank you for explaining how to use the paths. Can you try any RTF-converted file? I am unsure if I attach a file here because most people won't download it because of safety issues. Thank you again for your patience
|
#10
|
|||
|
|||
VBAlearn, I've just run the macro on two folders with three identically-named rtf files each. And it worked without a hitch. It's hard to find a solution without seeing your files. Could you upload at least one simplified original file and the same file with minor modifications.
|
#11
|
|||
|
|||
It presents a formidable challenge to solve, but I'm optimistic about your ability to find a solution.
|
#12
|
|||
|
|||
Thanks for helping me out, @Vivika; I attached the 'dummy1' docx file. Actually, it's an 'RTF' file, but it's an invalid file type to attach so, I converted it to a docx file. Can you please convert to RTF check it out and let me know if it worked.
|
#13
|
|||
|
|||
Hi Vivika did you get a chance to check my document?
|
#14
|
|||
|
|||
Hi,VBAlearn! The code works flawlessly with your files converted to .rtf format.
Three notes: 1. Make sure to enter the ending backslash after the paths to your folders (d:\your_fldr\); 2. After opening the resulting file, find a vertical line near the page's left margin. Click on it to see or hide the comparison results. If the results are hidden, the line becomes red, if the results are visible, the line is blue (or whatever, but not red). 3. What kind of error and on which line do you get? |
Tags |
vba macro |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Macro security issue | harry | Outlook | 1 | 01-19-2023 12:21 AM |
Path issue using a macro on the ribbon | troels | Excel Programming | 1 | 05-26-2015 10:25 AM |
issue in running macro in mac | expert4knowledge | Word VBA | 5 | 08-13-2014 02:33 PM |
MS Publisher Macro Issue | Chayes | Office | 0 | 06-16-2013 11:36 AM |
Macro Issue | Basanth | Excel | 1 | 12-05-2008 08:07 PM |