Find out Difference between two Excels using Vbs?

 
 
  Dim sExcelFile1
  Dim sTextFile1,FSO
  Dim TextStream,TextStream1
  Dim S,fso1,s1,ResFile,sDiff
  Dim File,File1
  Set fso1 = CreateObject("Scripting.FileSystemObject")
  Set ResFile = fso1.CreateTextFile("D:\diffFile.txt", True)
 
  sExcelFile1 ="C:\Documents and Settings\vgurusam\Desktop\reliance.xls"
  sExcelFile2 ="C:\Documents and Settings\vgurusam\Desktop\Copy of reliance.xls"
  sTextFile1 ="D:\testfile.txt"
  sTextFile2 ="D:\testfile1.txt"
  Call ReadExcel (sExcelFile1,sTextFile1)
  Call ReadExcel (sExcelFile2,sTextFile2)
 
  Set FSO = CreateObject("Scripting.FileSystemObject")
  Set File = FSO.GetFile(sTextFile1)
  Set File1 = FSO.GetFile(sTextFile2)
  Set TextStream = File.OpenAsTextStream(1)
  Set TextStream1 = File1.OpenAsTextStream(1)
  
   Do    While Not TextStream.AtEndOfStream
      S =  TextStream.ReadLine & NewLine
      s1=  TextStream1.ReadLine & NewLine
      If (S <> s1) Then
        sDiff="Different Cell:: " & " String1 ::" & S & " String2 ::" & S1
'       WScript.Echo (S1)
       ResFile.WriteLine(sDiff)
      End If
      s1 =""
      S=""
      sDiff=""
   Loop
   TextStream.Close
TextStream1.Close
ResFile.close
 

  Function ReadExcel(sExcelFile,sTextFilePath)

   Dim fso, MyFile
   Set fso = CreateObject("Scripting.FileSystemObject")
  ' Set MyFile = fso.CreateTextFile("D:\testfile.txt", True)
    Set MyFile = fso.CreateTextFile(sTextFilePath, True)
    Dim sExcelPath 'As Variant  'Excel file
    '********** Excel object declaration **********'
     ' Excel Application object
    Dim objExcel 'As Excel.Application
    Dim objXLWorkbooks 'As Excel.Workbooks
    Dim objXLWorkbook 'As Excel.Workbook

    Dim WorkSheetCount 'As Variant  'Work sheets count in a excel
    Dim CurrentWorkSheet 'As Excel.Worksheet    ' Current worksheet
    Dim objCells 'As Excel.Range
    Dim objCurrentCell 'As Variant
    Dim objFont 'As Variant

    ' Result contents
    Dim sCellText 'As Variant
    Dim sFontName 'As Variant
    Dim sFontStyle 'As Variant
    Dim iFontSize 'As Variant
    Dim iCellTextColorIndex 'As Variant
    Dim iCellInteriorColorIndex 'As Variant
    Dim sResult 'As Variant
    Dim sChartFile 'As String


    ' Row and Col integer variables
    Dim iUsedRowsCount 'As Integer
    Dim iUsedColsCount 'As Integer
    Dim iTop, iLeft 'As Integer
    Dim iRow 'As Integer     'Row item
    Dim iCol 'As Integer     'Col item
    Dim iCurRow 'As Integer
    Dim iCurCol 'As Integer


    If (sExcelFile = "") Then
            sExcelPath = "D:\excel.xls"
    Else
            sExcelPath = sExcelFile
    End If

    If (iSheetIndex = "") Then
        iSheetIndex = 1
    End If


'    Call FileDeleteAndCreate (gsLogFile)

    'XL file check
'    If (FileExists(sExcelPath) <> 0) Then
'        Call LogWrite (gsLogFile, "The Excel file " & Chr(34) & sExcelPath & Chr(34) & " does not exit!")
'        Exit sub
'    End If

    Set objExcel = CreateObject("Excel.Application")
    objExcel.Workbooks.Open sExcelPath, False, True

    On Error Resume Next


    WorkSheetCount = objExcel.Worksheets.Count

    Set objXLWorkbook = objExcel.ActiveWorkbook


    Set CurrentWorkSheet = objExcel.ActiveWorkbook.Worksheets(iSheetIndex) 'iSheetIndex worksheet

    iUsedRowsCount = CurrentWorkSheet.UsedRange.Rows.Count
    iUsedColsCount = CurrentWorkSheet.UsedRange.Columns.Count
    iTop = CurrentWorkSheet.UsedRange.Row
    iLeft = CurrentWorkSheet.UsedRange.Column

    CurrentWorkSheet.UsedRange.Columns.AutoFit()
    ' Cells object
    CurrentWorkSheet.Cells.Activate


    For iRow = iTop To iUsedRowsCount   '(iUsedRowsCount - 1)
            'Read All rows
            For iCol = iLeft To iUsedColsCount  '(iUsedColsCount - 1)

                    sResult = ""
                    Set objCurrentCell = CurrentWorkSheet.Cells(iRow, iCol)
                    sCellText = objCurrentCell.Text


                    If ((sCellText = Empty)) Then


                            sResult = "Reading Cell {" & CStr(iRow) & ", " & CStr(iCol) & "}^" &"  "& "^" & "  " & "^" & "  " & "^" & "  " & "^" & "  " & "^" & "  "

                            Call LogWrite (gsLogFile, sResult)

                    Else
                            Set objFont = objCurrentCell.Font
                            sFontName = objFont.Name
                            sFontStyle = objFont.FontStyle
                            iFontSize = objFont.Size
                            iCellTextColorIndex = objFont.Color
                            iCellInteriorColorIndex = objCurrentCell.Interior.ColorIndex



                            If (sFontName = Empty) Then
                                    sFontName = "empty"
                            End If
                            If (sFontStyle = Empty) Then
                                    sFontStyle = "empty"
                            End If
                            If (iFontSize = Empty) Then
                                    iFontSize = "-99999999"
                            End If
                            If (iCellTextColorIndex = Empty) Then
                                    iCellTextColorIndex = "99999999"
                            End If
                            If (iCellInteriorColorIndex = Empty) Then
                                    iCellInteriorColorIndex = "99999999"
                            End If

                            sResult = "Reading Cell {" & CStr(iRow) & ", " & CStr(iCol) & "}^" & sCellText & "^" & CStr(iCellInteriorColorIndex) & "^" & sFontName & "^" & CStr(sFontStyle) & "^" & CStr(iFontSize) & "^" & CStr(iCellTextColorIndex)

'                            Call LogWrite (gsLogFile, sResult)
                            MyFile.WriteLine(sResult)

                    End If

                    Set objCurrentCell = Nothing


            Next

    Next
    MyFile.Close
   
    objExcel.ActiveWorkbook.Saved = True
    Set CurrentWorkSheet = Nothing
    objExcel.Quit
    Set objExcel = Nothing
End Function