|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
Compare files in different directories, slightly different namesm, Macro doesn't loop
Situation: Two different directories with containing files where:
1. file names may vary slightly but the first 8 characters WILL match. 2. Some files *may* be in one directory but not the other. 3. If a file is missing, make it a blank file as a placeholder. I trolled around and found a macro for comparing multiple files in different directories but the file names had to match. Edited it and voila! now it doesn't loop. Yes the directories contain more than one file. Suggestions? TIA. Code:
Sub CompareAllFiles2() Dim strFolder(2), SourceFolder(2), fLoc As String Dim strFileSpec, strFileName As String, FileB As String Dim objDocA As Word.Document Dim objDocB As Word.Document Dim objDocC As Word.Document Dim n As Integer strFolder(0) = "Enter path to base documents:" strFolder(1) = "Enter path to new documents:" strFolder(2) = "Enter path for document comparisons to be saved:" ' For n = 0 To 2 ' SourceFolder(n) = GetFolder(strFolder(n)) & "\" ' Next n ' added this for testing purposes... SourceFolder(0) = "c:\projects\test\01_Specifications" SourceFolder(1) = "c:\projects\test\01_Specifications NEW" SourceFolder(2) = "c:\projects\test\compare" strFileSpec = "*.docx" strFileName = Dir$(SourceFolder(0) & "\" & strFileSpec) Do While strFileName <> "" 'vbNullString Set objDocA = Documents.Open(SourceFolder(0) & "\" & strFileName) FileB = Dir$(SourceFolder(1) & "\" & Left(strFileName, 8) & "*.docx") ' if file isn't found in new directory, make an empty file If Left(Dir$(SourceFolder(0) & "\" & strFileName), 8) Like _ Left(FileB, 8) Then ' Set objDocB = Documents.Open(SourceFolder(1) & "\" & strFileName) Set objDocB = Documents.Open(SourceFolder(1) & "\" & FileB) Application.CompareDocuments _ OriginalDocument:=objDocA, _ RevisedDocument:=objDocB, _ Destination:=wdCompareDestinationNew, CompareFormatting:=False, _ CompareWhitespace:=False objDocA.Close objDocB.Close Set objDocC = ActiveDocument objDocC.SaveAs FileName:=SourceFolder(2) & "\" & strFileName objDocC.Close SaveChanges:=True Else Set objDocC = Documents.Add objDocC.SaveAs2 FileName:=SourceFolder(2) & "\" & Left(strFileName, 11) & _ "NO DOC.docx" objDocC.Close objDocA.Close End If strFileName = Dir Loop Set objDocA = Nothing Set objDocB = Nothing End Sub Function GetFolder(strFolder) As String Dim oFolder As Object GetFolder = "" Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, strFolder, 0) If (Not oFolder Is Nothing) Then GetFolder = oFolder.ItemS.Item.Path Set oFolder = Nothing End Function |
Tags |
compare documents, looping |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Loop through files and Copy Table Row and Paste into Different Document | spiderman1369 | Word VBA | 2 | 10-15-2014 08:30 AM |
Loop Macro to Edit Date | damaniam | Word VBA | 7 | 02-21-2014 07:12 AM |
Macro to loop in Word | Yamaha Rider | Word VBA | 2 | 02-07-2012 05:33 PM |
Compare and Update Macro | AaronMoss | Excel Programming | 2 | 05-06-2011 04:54 AM |
compare files | rmartin8 | Word | 1 | 02-10-2009 10:27 AM |