|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
Macro Help - Compare current document with another document in the same folder
Hi, I've searched the forums and tried writing this macro myself to no avail. I want to create a Compare function that compares the current document (as either the original or revised document) with another document in the same folder. I would like a prompt to select the document from the folder.
Bonus points if the macro can also automatically name the compare document like the revised document, but with appended text. This is not at all essential, though. |
#2
|
||||
|
||||
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
Awesome, thank you. For those searching in the future, I modified the code as follows, and it works great for what I need. This will prompt a filepicker (defaulted to the directory in which the active document is located) to select the document to compare against, run the comparison, and prompt to save as the filename of the revised document, with " - redline" appended. This was designed for use in the legal redline (aka blackline) context. This saves substantial clicking and aggravation when running redlines.
Code:
Sub FastCompare() Application.ScreenUpdating = False Dim StrDocOld As String, DocOld As Document Dim StrDocNew As String, DocNew As Document Dim DocNewPath As String Set DocNew = ActiveDocument StrDocNew = DocNew.FullName DocNewPath = DocNew.Path ' select "original" document to compare active document against With Application.FileDialog(FileDialogType:=msoFileDialogFilePicker) .Title = "Select the Original Document" .AllowMultiSelect = False .Filters.Add "Documents", "*.doc; *.docx; *.docm", 1 .InitialFileName = DocNewPath .ButtonName = "Compare" If .Show = -1 Then StrDocOld = .SelectedItems(1) Else GoTo ErrExit End If End With Set DocOld = Documents.Open(StrDocOld) ' run comparison Dim DocRev As Document Set DocRev = Application.CompareDocuments( _ OriginalDocument:=DocOld, RevisedDocument:=DocNew, _ Destination:=wdCompareDestinationNew, Granularity:=wdGranularityWordLevel, _ CompareFormatting:=False, CompareCaseChanges:=True, CompareWhitespace:=False, _ CompareTables:=True, CompareHeaders:=True, CompareFootnotes:=True, _ CompareTextboxes:=True, CompareFields:=False, CompareComments:=True, _ CompareMoves:=True, RevisedAuthor:="Author", IgnoreAllComparisonWarnings:=False) ' save comparison with filename of DocNew with " - redline" appended StrDocNew = Left(StrDocNew, (InStrRev(StrDocNew, ".", -1, vbTextCompare) - 1)) With Application.Dialogs(wdDialogFileSaveAs) .Name = StrDocNew & " - redline" .Show End With ' Close DocOld DocOld.Close ' Bring DocRev to front DocRev.Activate Application.ScreenUpdating = True ErrExit: Set DocOld = Nothing: Set DocNew = Nothing: Set DocRev = Nothing End Sub |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
How to redact words listed in one document from the current document | AlanofBayCourt | Word VBA | 0 | 10-31-2019 03:00 AM |
Macro to Change Document Font in All Documents in a Folder | jtomolonis08 | Word VBA | 1 | 06-07-2019 05:59 PM |
Creating a macro from a non-saved Word doc that duplicates the current open document and saves it | mike0215 | Word VBA | 3 | 11-17-2017 01:40 PM |
macro, data import from the ONLY text file in current folder | ue418 | Excel Programming | 5 | 10-28-2017 12:52 PM |
From a docx report document save all images in a cell from the document to a folder | censura | Word VBA | 1 | 05-13-2017 12:54 AM |