Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 10-01-2019, 05:48 AM
scienceguy scienceguy is offline Batch Comparing Multiple Word Files Windows 10 Batch Comparing Multiple Word Files Office 2016
Advanced Beginner
Batch Comparing Multiple Word Files
 
Join Date: Feb 2019
Posts: 46
scienceguy is on a distinguished road
Default Batch Comparing Multiple Word Files

Hello,



I am trying to write an application, whereby Word vba will compare Word files in one folder (original version) with the corresponding files in another folder (updated or revised version) and show the track changes. The application would process one file at a time and save the tracked changed file as "original_file_name_tracked.docx". In the end, the application would have generated a tracked change version of each set of files (original versus revised).

To accomplish this, I recorded a macro in Word vba that processed the first file. I then modified the code to work on an entire folder, one file at a time. Unfortunately, I am getting a run-time error 4160 (Bad File Name). I went back to the original recorded macro and ran it (without any modifications on my part), and it also throws the same error. If any one has any suggestions, I would appreciate it. Below is my code for processing a folder.

Thank you in advance for any help!

Sincerely,
Roy


Code:
Sub trackMe()
'
' trackMe Macro
'
Dim strFolderOriginal As String, strFolderUpdated As String
Dim strfile As String
Dim tempFileName As String

'original
With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show = -1 Then
        strFolderOriginal = .SelectedItems(1)
    End If
End With
If strFolderOriginal = "" Then
    Exit Sub
End If

'updated
With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show = -1 Then
        strFolderUpdated = .SelectedItems(1)
    End If
End With
If strFolderUpdated = "" Then
    Exit Sub
End If

strfile = Dir(strFolderOriginal & "\*.doc", vbNormal)

While strfile <> ""

    tempFileName = stripFileName(strfile) 'remove file extension
    
    ChangeFileOpenDirectory strFolderOriginal & "\"
    ChangeFileOpenDirectory strFolderUpdated & "\"
    
    Application.CompareDocuments OriginalDocument:=Documents( _
        strfile) _
        , RevisedDocument:=Documents( _
        strfile) _
        , Destination:=wdCompareDestinationOriginal, Granularity:= _
        wdGranularityCharLevel, CompareFormatting:=True, CompareCaseChanges:=True _
        , CompareWhitespace:=True, CompareTables:=True, CompareHeaders:=True, _
        CompareFootnotes:=True, CompareTextboxes:=True, CompareFields:=True, _
        CompareComments:=True, CompareMoves:=True, RevisedAuthor:="Author", _
        IgnoreAllComparisonWarnings:=False
        
    ChangeFileOpenDirectory strFolderOriginal & "\"
    
    ActiveDocument.SaveAs2 FileName:= _
        tempFileName & "_tracked.docx" _
        , FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
        AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
        EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
        :=False, SaveAsAOCELetter:=False, CompatibilityMode:=12
        
    strfile = Dir()
Wend

MsgBox "Finished"

End Sub
Function stripFileName(strFilename As String) As String
'used to remove file extension

Dim k As Integer

For k = Len(strFilename) To 1 Step -1
    If Mid(strFilename, k, 1) = "." Then
        stripFileName = Mid(strFilename, 1, k - 1)
        Exit For
    End If
Next k


End Function
Reply With Quote
  #2  
Old 03-28-2020, 07:19 AM
Randysrandy Randysrandy is offline Batch Comparing Multiple Word Files Windows 10 Batch Comparing Multiple Word Files Office 2019
Novice
 
Join Date: Mar 2020
Posts: 1
Randysrandy is on a distinguished road
Default

Hi there,
Did you ever get this to work? This would be a very useful capability to have right now!
Thanks,
Randy
Reply With Quote
  #3  
Old 10-27-2021, 07:43 AM
djonsen djonsen is offline Batch Comparing Multiple Word Files Mac OS X Batch Comparing Multiple Word Files Office 2019
Novice
 
Join Date: Oct 2021
Posts: 1
djonsen is on a distinguished road
Default Re: Batch Comparing Multiple Word Files

Hi scienceguy,

Thank you for posting this - I used your script as the beginning of mine, which is below and works on my Mac, so I would assume it will work on Windows as well with different directories defined. I think the problem with your script is that you tried to compare two documents without opening them first. This script takes a corresponding pair of documents, opens them, compares them, saves the tracked change document with the comparisons, closes all files, then loops to the next pair of files. I wrote this specifically to compare old and new revisions of controlled documents in our company's quality management system, so it determines the "document number" in the beginning of the old rev file name and uses that with a wild card to search for the corresponding new file in the "new files" folder. I hope you can use it to make your application work.

================================================== ===

Code:
Sub DoDiffs()
    Dim strOldFolder As String, strNewFolder As String, strDifFolder As String
    Dim strOldFile As String, strNewFile As String, strDocNum As String
    Dim strOldFileFull As String, strNewFileFull As String
    Dim I As Long, J As Long, N As Long
    Dim OldFileList() As String, NewFileList() As String, DocNums() As String, FilePermList() As String
    ReDim OldFileList(1000)
    
    'Re-define the 3 strings below as appropriate for your system
    strOldFolder = "/Users/dan/Desktop/QMS_Updates/Old/"
    strNewFolder = "/Users/dan/Desktop/QMS_Updates/New/"
    strDifFolder = "/Users/dan/Desktop/QMS_Updates/Dif/"
    
    'Get list of old file names
    strOldFile = Dir$(strOldFolder & "*.docx", vbNormal)
    I = 0
    Do While strOldFile <> ""
        OldFileList(I) = strOldFile
        strOldFile = Dir$
        I = I + 1
    Loop
    N = I - 1
    ReDim Preserve OldFileList(0 To N)
    ReDim NewFileList(0 To N)
    ReDim DocNums(0 To N)
    
    'From old file names, get document Number (everything up to the first space)
    'and find corresponding new file with the same document number, then build old
    'and new file list arrays with full paths
    For I = 0 To N
        strOldFile = OldFileList(I)
        strDocNum = Left(strOldFile, InStr(1, strOldFile, " ") - 1)
        strNewFile = Dir$(strNewFolder & strDocNum & "*.docx", vbNormal)
        strOldFileFull = strOldFolder & strOldFile
        strNewFileFull = strNewFolder & strNewFile
        OldFileList(I) = strOldFileFull
        NewFileList(I) = strNewFileFull
        DocNums(I) = strDocNum
    Next I
    
'*** Un-comment until the next '*** if you use a Mac and you keep getting the "grant access to file?" dialog
'    ReDim FilePermList(0 To N * 2 + 2)
'    J = 0
'    For I = 0 To N
'        FilePermList(J) = OldFileList(I)
'        J = J + 1
'        FilePermList(J) = NewFileList(I)
'        J = J + 1
'    Next I
'    FilePermList(N * 2 + 2) = strDifFolder
'    Dim fileAccessGranted As Boolean
'    fileAccessGranted = GrantAccessToMultipleFiles(FilePermList) 'returns true if access granted, false otherwise
'***
    'Open each corresponding pair of old and new files, and save the changed tracked file
    ' to the "diffs" folder
    For I = 0 To N
        Documents.Open (OldFileList(I))
        Documents.Open (NewFileList(I))
        Application.CompareDocuments OriginalDocument:=Documents(OldFileList(I)), RevisedDocument:=Documents(NewFileList(I)), CompareFormatting:=False
        ActiveDocument.SaveAs2 (strDifFolder & DocNums(I) & "_Diffs.docx")
        Documents.Close
    Next I
End Sub
Reply With Quote
Reply

Tags
batch processing, track changes

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
batch extract all tables in multiple word documents ZaidaBa Word Tables 3 05-08-2017 10:22 PM
Batch Comparing Multiple Word Files Batch create word files with link to changing excel hannes.ledegen Mail Merge 8 04-07-2016 01:22 AM
Batch Comparing Multiple Word Files Batch add suffix to PDF files in folder Dave T Windows 2 03-01-2016 08:07 PM
Remove Compatibility Mode on DOCX files (batch) w64bit Word 17 02-01-2015 06:02 AM
Macro to format additions deletions when Comparing Files Alphacsulb Word VBA 0 08-19-2013 03:03 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 03:19 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft