Excel Macro to compare contents of text files in two folders which has same name

[vanidirossi]

Hi

I need to compare two folder contents. Both the folders contains list of files with same names. I need to compare the file contents of the files having same names and display the difference in say column A

also there might be a possibility that, some files maybe not present in eithe rof the Folders, I also want to higlight these missing files in Column B.

Appreciate your kind help!

[JBeaucaire]

Please provide examples of two text files with the same name (different enough you can provide them here, we can adust) and an example in Excel of the actual output you expect. Show us the goal.

Click on GO ADVANCED and use the paperclip icon to open the upload window.

View Pic

[vanidirossi]

folder A
File1.txt
File2.txt
File3.txt

folder B
File1.txt
File2.txt

so this is the folders and the files . Is it possible that file1.txt in folder A be compared with File1.txt in folder B, file2.txt in folder A compared with file2.txt in folder B, If there is a difference in the content canalso the difference be captured and displayed in column A of the excel?

Basically i want files having same names to be compared and the differences (if any) be captured and stored in column A .

Thanks in advance

[vanidirossi]

I found this code but it breaks each line into words and compares only the 4th and 8th word of the two files and then notes the difference it also returns the line number where the difference this code would have been helpful can you help me modify this code such that it compares the entire file content and not just the 4th and 8th word on every line of the file?

Option Explicit
Sub Main()
  Dim Folder(0 To 1) As String
  Dim Files(0 To 1) As Object    'Dictionary
  Dim NotFound As Object    'Dictionary
  Dim Found As Object    'Dictionary
  Dim Item, Result
  Dim i As Long, j As Long
  Dim fso As Object    'FileSystemObject
  '
  'Erase used range
  Columns("A:I").ClearContents
  '
  'Setup path to folder
  Folder(0) = "C:\temp\Folder_A"
  Folder(1) = "C:\temp\Folder_B"
  '
  'Get all PRN files
  For i = 0 To 1
    Set Files(i) = FilesToDict(Folder(i), "*.prn")
  Next
  '
  'Compare found files in the other folder and vice versa
  Set Found = CreateObject("Scripting.Dictionary")
  For i = 0 To 1
    j = (i + 1) Mod 2
    Set NotFound = CreateObject("Scripting.Dictionary")
    For Each Item In Files(i)
      If Not Files(j).Exists(Item) Then
        NotFound.Add Item, Item
      ElseIf i = 0 Then
        Found.Add Item, Item
      End If
    Next
    '
    'Output the difference to column A and B
    With Range("A1")
      .Offset(0, i) = "Not in " & Folder(j)
      If NotFound.Count > 0 Then
        Item = NotFound.Items
        .Offset(1, i).Resize(UBound(Item) + 1, 1) = WorksheetFunction.Transpose(Item)
      End If
    End With
  Next
  '
  'Start the comparing of equal filenames
  With Range("C1")
    .Value = "Found in both"
    Set fso = CreateObject("Scripting.FileSystemObject")
    j = 1
    'Retrieve all filenames
    Item = Found.Items
    For i = 0 To UBound(Item)
      'Store the filename
      .Offset(j, 0) = Item(i)
      'Compare the files in both folders
      Result = ComparePRN(fso.BuildPath(Folder(0), Item(i)), fso.BuildPath(Folder(1), Item(i))).Items
      'Store the result
      .Offset(j, 1).Resize(UBound(Result) + 1, 1) = WorksheetFunction.Transpose(Result)
      'Next position
      j = j + UBound(Result) + 1
    Next
    'Split result by ; into columns
    On Error Resume Next
    .Offset(0, 1).EntireColumn.TextToColumns DataType:=xlDelimited, Semicolon:=True
  End With
End Sub
Private Function FilesToDict(Path As String, Mask As String) As Object 'Dictionary
  Dim fso As Object    'FileSystemObject
  Dim F As Object    'File
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set FilesToDict = CreateObject("Scripting.Dictionary")
  FilesToDict.CompareMode = vbTextCompare
  If Not fso.FolderExists(Path) Then Exit Function
  For Each F In fso.GetFolder(Path).Files
    If F.Name Like Mask Then FilesToDict.Add F.Name, F.Name
  Next
End Function
Private Function ComparePRN(FName1 As String, FName2 As String) As Object 'Dictionary
  Const Delimiter = ";"
  Dim fso As Object    'FileSystemObject
  Dim TS As Object    'TextStream
  Dim Lines(0 To 1)
  Dim Word(0 To 1)
  Dim Equal8 As Boolean, Equal4 As Boolean
  Dim LineNr As Long
  Dim i As Integer
  Dim Result As String
  
  Set ComparePRN = CreateObject("Scripting.Dictionary")
  'Install errorhandler
  On Error GoTo ErrorHandler
  'Read in the contents
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set TS = fso.OpenTextFile(FName1)
  Lines(0) = Split(TS.ReadAll, vbCrLf)
  TS.Close
  Set TS = fso.OpenTextFile(FName2)
  Lines(1) = Split(TS.ReadAll, vbCrLf)
  TS.Close
  
  'Compare the lines starting by line #9 (Note: Our arrays are zero based, means the first line is line #0!)
  For LineNr = 8 To WorksheetFunction.Min(UBound(Lines(0)), UBound(Lines(1)))
    'Separate the words from the line
    For i = 0 To 1
      Word(i) = Split(TrimDouble(Trim$(Lines(i)(LineNr)), Compare:=vbBinaryCompare))
    Next
    'Compare the words #8 and #4
    Equal8 = StrComp(Word(0)(7), Word(1)(7), vbTextCompare) = 0
    Equal4 = StrComp(Word(0)(3), Word(1)(3), vbTextCompare) = 0
    If Equal8 Then
      If Equal4 Then
        'A. If word#8 (file in folder_A) = word#8 (file in folder_B) _
          an word#4 (file in folder_A) = word#4 (file in folder_B) then
        '  1. Write "No difference"
        '  2. Continue with the next files to compare
        If ComparePRN.Count = 0 Then
          'Add this only if no differences are in the whole file
          Result = "No difference"
          ComparePRN.Add LineNr, Result
        End If
        Exit Function
      Else
        'C. If word#4 (file in folder_A) <> word # 4 (file in folder_B) then Output
        ' Word #3 (file1-folderA )__ Word#8 (file1 folderA)__ Word#4 ( _
          file1 folderA ) Word# 8 (file2, Folder B)_  Word#4 ( file 2, _
          Folder B)__"length different"
        Result = ""
        Result = Result & Word(0)(2) & Delimiter
        Result = Result & Word(0)(7) & Delimiter
        Result = Result & Word(0)(3) & Delimiter
        Result = Result & Word(1)(7) & Delimiter
        Result = Result & Word(1)(3) & Delimiter
        Result = Result & "length different"
        ComparePRN.Add LineNr, Result
      End If
    Else
      If Equal4 Then
        'B. If word # 8 (file in folder_A) <> word # 8 (file in folder_B) then Output
        '(starting at column"A")
        ' Word #3 (file1-folderA )__ Word#8 (file1 folderA)__ Word#4 ( _
          file1 folderA ) Word# 8 (file2, Folder B)_  Word#4 ( file 2, _
          Folder B)__"name different"
        Result = ""
        Result = Result & Word(0)(2) & Delimiter
        Result = Result & Word(0)(7) & Delimiter
        Result = Result & Word(0)(3) & Delimiter
        Result = Result & Word(1)(7) & Delimiter
        Result = Result & Word(1)(3) & Delimiter
        Result = Result & "name different"
        ComparePRN.Add LineNr, Result
      Else
        'D. If word# 8 <> word # 8 and word# 4 <> word #4 then produce _
          the same output line described in item "B" but say"line is " & _
          "different"
        Result = ""
        Result = Result & Word(0)(2) & Delimiter
        Result = Result & Word(0)(7) & Delimiter
        Result = Result & Word(0)(3) & Delimiter
        Result = Result & Word(1)(7) & Delimiter
        Result = Result & Word(1)(3) & Delimiter
        Result = Result & "line is different"
        ComparePRN.Add LineNr, Result
      End If
    End If
  Next
  Exit Function
ErrorHandler:
  Result = "Error " & Err.Number & " in Line " & LineNr & ": " & Err.Description
  ComparePRN.Add LineNr, Result
End Function
Function TrimDouble(ByVal S As String, Optional ByVal Delim As String = " ", _
    Optional ByVal ConsecutiveDelim As Boolean = False, _
    Optional ByVal Compare As VbCompareMethod = vbTextCompare) As String
  'Liefert einen String in dem keine mehrfachen (Leer-)Zeichen mehr sind
  Dim i As Long, DoubleDelim As String, SingleDelim As String
  If ConsecutiveDelim Or Len(Delim) = 1 Then
    DoubleDelim = Delim & Delim
    Do While InStr(1, S, DoubleDelim, Compare) > 0
      S = Replace$(S, DoubleDelim, Delim, Compare:=Compare)
    Loop
  Else
    For i = 1 To Len(Delim)
      SingleDelim = Mid$(Delim, i, 1)
      DoubleDelim = String$(2, SingleDelim)
      Do While InStr(1, S, DoubleDelim, Compare) > 0
        S = Replace$(S, DoubleDelim, SingleDelim, Compare:=Compare)
      Loop
    Next
  End If
  TrimDouble = S
End Function

[JBeaucaire]

Please provide examples of two text files with the same name (different enough you can provide them here, we can adust) and an example in Excel of the actual output you expect. Show us the goal.

Click on GO ADVANCED and use the paperclip icon to open the upload window.

View Pic

That was my original request. I understand the simple "listing missing files in column B", but the more important column A sounds like you've not really thought it through. That's why I want you to take two of your files that should be compared (File1a.txt and File1b.txt) and then show in an Excel sheet how you would want the differences between those two files presented. You need to do the work once manually so we can see exactly what you see as different and exactly how that gets presented.

[vanidirossi]

Hi Jerry,

File1a.txt contains the following text

test data 1 test data 2 test data 3
test data 3 testa data 2 test data 4


File1b.txt contains the following data

test data 1 test data 2 test data 3
test data 3 test data 1 test data 4


Note : Thel 2nd line in both the files are different. The column A should display the file name which has the difference and column B should denote the Line number and the contents of the line as follows

Column A Column B

File1a.txt Line 2 : Does not match,
File1b.txt File1a.txt contains test data 3 testa data 2 test data 4
File2a.txt contains test data 3 test data 1 test data 4


In this manner every line of the both the files should be read and compared. Hope this was helpful

Br,
Vandross

[JBeaucaire]

So then what you want is full would be:

1) The ability to designate two source folders
2) Cycle through the first folder and put every filename in column A
3) Compare each line in full the exact same file in the second folder, if any line is found to be different, note that line number in column B
4) If all lines are the same, mark the column B as "same"
5) Repeat with all listed files from first column
6) Any files in first folder not found in second folder are marked in column B as "Missing from second folder"

7) Now go to second folder and find any remaining files there that are not already on the column A list, meaning these files are not in first folder, add them to the column A listing and mark them in column B as "Missing from first folder"

8) Remove all the lines that were the "same" leaving only the error files in the resulting report.

Sound right?

[JBeaucaire]

It's a lot of code, but I tested with two folders and 5 files in each and it seems to be doing what you've described.

Differences are listed line by line.
Missing files are listed.

The macro will ask you to pick each of the folders to start each time.

Option Explicit

Sub CompareTwoFoldersTXTFiles()
'9/23/2014   Jerry Beaucaire     www.ExcelForum.com
'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 & "*.txt")                      '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 & "*.txt")                  'get next file1 name
    Loop
    
    fNAME2 = Dir(fPATH2 & "*.txt")                  '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