Function Comparedata(strFileName1,strFileName2,ColumnName)
Dim iShtCnt1,iShtCnt2,strSheetName,strSQLStatement1,iCurRow,Query,iColCnt,iCol,curColName,curColValue,CurQuery
Dim bFound,j,strSQLStatement2,RecSet2,iRecordCnt
Set oBook1 = oExcel.Workbooks.Open(strFileName1)
Set oBook2 = oExcel.Workbooks.Open(strFileName2)
iShtCnt1 = oBook1.Sheets.Count
iShtCnt2 = oBook2.Sheets.Count
If iShtCnt1 <> iShtCnt2 Then Reporter.ReportEvent micFail,"Compare Report - Sheets Count Mismatch":Exit Function
oBook1.Close
oBook2.Close
oExcel.Quit
Set oExcel = Nothing
Set objCon2 = ConnectToExcel(strFileName2)
For i = 1 to iShtCnt1
strSheetName = allSheetNames(i-1)
strSQLStatement1 = "" & "SELECT * FROM [" & Left(strSheetName,31) & "$] WHERE [" & ColumnName & "] IS NOT NULL AND [" & ColumnName & "] <> ' '"
Set RecSet1 = GetContentFromDB(strFileName1, strSQLStatement1)
If Not RecSet1.EOF Then
iCurRow = 2
Do while RecSet1.EOF <> True
If RecSet1.Fields(0).Value <> "" Then
Query = ""
iColCnt = RecSet1.Fields.Count -1
For iCol = 0 To iColCnt
curColName = RecSet1.Fields(iCol).Name
curColValue = RecSet1.Fields(iCol).Value
If IsNull(curColValue) Then
CurQuery = "[" & curColName & "] IS NULL" & ""
ElseIf curColValue = "" Then
CurQuery = "[" & curColName & "] = ' " & curColValue & "'"
Else
CurQuery = "[" & curColName & "] = '" & curColValue & "'"
End If
If Query = "" Then
Query = CurQuery
Else
Query = Query & " AND " & CurQuery
End If
Next
'Verify in all the Sheets
bFound = False
For j= 1 to iShtCnt2
strSheetName =allSheetNames(i-1)
strSQLStatement2 = "" & "SELECT * FROM [" & Left(strSheetName,31) & "$] WHERE " & Query
Set RecSet2 = objCon2.Execute(strSQLStatement2)
If RecSet2.EOF = False Then bFound = True :Exit For
Next
If NOT bFound Then
Reporter.ReportEvent micFail,"Record mismatch. Query - > " & Cstr(Query)
End If
Else
Reporter.ReportEvent micPass,"Blank row exist","Blank row exist in row - > " & iCurRow -1
End If
RecSet1.MoveNext
iCurRow = iCurRow + 1
Print "Rows Compared : - > " & iCurRow -2 & " " & Now()
Loop
Else
Reporter.ReportEvent micFail,"No records Found. " & strFileName1
End If
Next
Set oFso = Nothing
objCon2.Close
Set objCon2 = Nothing
End Function
Function GetContentFromDB(strFileName, strSQLStatement)
Dim objCon,objRecordSet
Err.clear
Set objCon = CreateObject("ADODB.Connection")
objCon.Open "DRIVER={Microsoft Excel Driver (*.xls)};DBQ="&strFileName & ";Readonly=True"
If Err.Number <> 0 Then
Reporter.ReportEvent micFail,"Create Connection", "[Connection] Error has occured. Error : " & Err
Set GetContentFromDB = Nothing
Exit Function
End If
Set objRecordSet = CreateObject("ADODB.Recordset")
objRecordSet.CursorLocation=3
objRecordSet.Open strSQLStatement, objCon,1, 3
Set GetContentFromDB = objRecordSet
If Err<>0 Then
Reporter.ReportEvent micFail,"Open Recordset", "Error has occured.Error Code : " & Err
Set GetContentFromDB = Nothing
Exit Function
End If
Set objRecordSet.ActiveConnection = Nothing
objCon.Close
Set objCon = Nothing
End Function
Function GetSheetNames(sSrcPath)
Dim curSheetName,strSheetNames
Set oBook = oExcel.Workbooks.Open(sSrcPath)
iShtCnt = oExcel.Sheets.Count
For i = 1 to iShtCnt
curSheetName = oExcel.Sheets(i).name
If allSheetNames = "" Then
allSheetNames = curSheetName
Else
allSheetNames = allSheetNames & ";" & curSheetName
End If
Next
oBook.Close
Set oBook = Nothing
GetSheetNames = allSheetNames
End Function
Function ConnectToExcel(strFileName)
Err.clear
objCon2.Open "DRIVER={Microsoft Excel Driver (*.xls)};DBQ="& strFileName & ";Readonly=True"
If Err.Number <> 0 Then
Reporter.ReportEvent micFail,"Create Connection", "[Connection] Error has occured. Error : " & Err
Set ConnectToExcel = Nothing
Exit Function
End If
Set ConnectToExcel = objCon2
Set objCon2 = Nothing
End Function
Comments