Bigwelshal
New Member
- Joined
- Sep 7, 2022
- Messages
- 4
- Office Version
- 365
- Platform
- Windows
Hi All,
I have the below code which compares files in two different folders with the same name and outputs the different lines. I need to edit this so that it asks to select two files with different names rather than looking at all files in two folders but shows the same output. I have been trying to edit this myself but am a bit stuck, any help would be greatly appreciated.
Many thanks!
I have the below code which compares files in two different folders with the same name and outputs the different lines. I need to edit this so that it asks to select two files with different names rather than looking at all files in two folders but shows the same output. I have been trying to edit this myself but am a bit stuck, any help would be greatly appreciated.
Many thanks!
VBA Code:
Sub CompareTwoFoldersTXTFiles()
'9/23/2014 - Jerry Beaucaire
'Compare identically named text files in two folders and list the differences line by line
'Missing files are also noted
Dim fPATH1 As String, fPATH2 As String, fNAME1 As String, fNAME2 As String
Dim f1 As String, f2 As String, temp1 As String, temp2 As String
Dim wsOUT As Worksheet, NR As Long, Cnt As Long
With Application.FileDialog(msoFileDialogFolderPicker) 'get folder names
.Title = "CHOOSE FOLDER 1"
.AllowMultiSelect = False
.InitialFileName = "C:\2013\TextFiles1\"
.Show
If .SelectedItems.Count > 0 Then
fPATH1 = .SelectedItems(1) & Application.PathSeparator
Else
Exit Sub
End If
.Title = "CHOOSE FOLDER 2"
.InitialFileName = "C:\2013\TextFiles2\"
.Show
If .SelectedItems.Count > 0 Then
fPATH2 = .SelectedItems(1) & Application.PathSeparator
Else
Exit Sub
End If
End With
On Error Resume Next
MkDir fPATH1 & "DONE" 'create DONE folders to temporarily store processed files
MkDir fPATH2 & "DONE"
On Error GoTo 0
Application.ScreenUpdating = False 'speed up macro, no screen draws
Set wsOUT = Sheets.Add(After:=Sheets(Sheets.Count)) 'create report sheet
With wsOUT
.Range("A1:B1").Value = [{"Filename", "Row #"}] 'add titles
.Range("C1") = fPATH1
.Range("D1") = fPATH2
.Range("A1:D1").Font.Bold = True
.Range("A2").Select
ActiveWindow.FreezePanes = True 'lock the top row
NR = 2 'next empty row
fNAME1 = Dir(fPATH1 & "*.csv") 'get first filename from folder1
Do While Len(fNAME1) > 0 'process each file individually
fNAME2 = Dir(fPATH2 & fNAME1) 'check for same file in folder2
If Len(fNAME2) = 0 Then 'make sure file exists
.Range("A" & NR).Value = fNAME1 'if not, note that
.Range("D" & NR).Value = "Does not exist"
NR = NR + 1
Else 'if so, compare them line by line
Cnt = 0
Open fPATH1 & fNAME1 For Input As #1 'open folder1 file
Open fPATH2 & fNAME2 For Input As #2 'open folder2 file
Do Until EOF(1)
Cnt = Cnt + 1 'make note of the line #
Line Input #1, temp1 'read in the line from file1
Line Input #2, temp2 'read in the line from file2
If temp1 <> temp2 Then 'compare the line, write them down if different
.Range("A" & NR).Value = fNAME1
.Range("B" & NR).Value = Cnt
.Range("C" & NR).Value = temp1
.Range("D" & NR).Value = temp2
NR = NR + 1 'next empty row
End If
Loop
Close #2 'close file2 and move it
Name fPATH2 & fNAME2 As fPATH2 & "DONE\" & fNAME2
Close #1 'close file1
End If
Name fPATH1 & fNAME1 As fPATH1 & "DONE\" & fNAME1 'move file1
fNAME1 = Dir(fPATH1 & "*.csv") 'get next file1 name
Loop
fNAME2 = Dir(fPATH2 & "*.csv") 'get first extra filename from folder 2
Do While Len(fNAME2) > 0 'list all found extra files
.Range("A" & NR).Value = fNAME2
.Range("C" & NR).Value = "Does not exist"
NR = NR + 1
fNAME2 = Dir 'next extra file
Loop
Shell "cmd /c move " & fPATH1 & "DONE\*.* " & fPATH1, vbHide 'move text files back to original position all at once
Shell "cmd /c move " & fPATH2 & "DONE\*.* " & fPATH2, vbHide 'move text files back to original position all at once
Application.Wait (Now + #12:00:03 AM#) 'wait 3 seconds for cmd lines to complete
RmDir fPATH1 & "DONE" 'delete the created DONE folders
RmDir fPATH2 & "DONE"
.Columns.AutoFit 'clean up the result
End With
Application.ScreenUpdating = True 'update the screen
End Sub
Last edited by a moderator: