Skip to main content

Compare two Excel files Row wise with ADODB Connection in QTP.

By

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
Labels:

Comments

Post a Comment

Popular posts from this blog

PDF Automation in QTP

By
                                                                            The most challenging issue with PDFs is that it could be of any kind, not just a tabular data; it could have plain text, images or even forms to fill up. So this makes a tester’s life a bit difficult, never mind, we will definitely find an easy of do it… Although there are already some better approaches we have to deal with PDF documents but I found many of us are facing so many difficulties using this. There are lots of queries coming at QTP forums asking for an easy way of doing it with PDFs. keeping those in my mind I started c...
Post a Comment
Read more

Convert JSON to XML using QTP/UFT/VBScript

By
Sample Code : Dim strPage,strJSON,objIE strPage = "C:\Jay\JLoader.html" Set objIE = CreateObject("InternetExplorer.Application") objIE.Visible = True objIE.Navigate2 strPage While objIE.Busy : Wend strJSON = "{""FirstName"":""Jay"", ""LastName"":""Krishna""}" Set objWin = objIE.document.parentWindow objWin.execScript "var jsonStr2XML = function(strJSON) { return json2xml(JSON.parse(strJSON));};" Msgbox  oWin.jsonStr2XML(strJSON) objIE.Quit In Detail: Converting The most popular data interchange format JSON(JavaScript Object Notation) to XML using QTP/UFT. Parsing JSON in UFT could be a challenge so we will use JavaScript in UFT to make it perfect. SO We need :              Java Script API  - To Convert JSON to XML                         JavaScript Files :  ...
Post a Comment
Read more

Download Test Resource From QC Using QTP

By
'########################################################################### '* Function Name: QCGetResource '* Designer: Jay '* Date 09-May-2012 '* This script will Download QC Test Resource to a local dir '########################################################################### Function QCGetResource(resourceName,saveTo)     Set qcConn = QCUtil.QCConnection     Set oResource = qcConn.QCResourceFactory     Set oFilter = oResource.Filter     oFilter.Filter("RSC_FILE_NAME") = resourceName     Set oResourceList = oFilter.NewList     If oResourceList.Count = 1 Then         Set oFile = oResourceList.Item(1)         oFile.FileName = resourceName         oFile.DownloadResource saveTo, True     End If         Set qcConn = Nothing     Set oResource = Nothi...
Post a Comment
Read more

compare Two Text files using Vb Script

By
Public Function CompareFiles (FilePath1, FilePath2) Dim FS, File1, File2 Set FS = CreateObject(“Scripting.FileSystemObject”) If FS.GetFile(FilePath1).Size <> FS.GetFile(FilePath2).Size Then CompareFiles = True Exit Function End If Set File1 = FS.GetFile(FilePath1).OpenAsTextStream(1, 0) Set File2 = FS.GetFile(FilePath2).OpenAsTextStream(1, 0) CompareFiles = False Do While File1.AtEndOfStream = False Str1 = File1.Read(1000) Str2 = File2.Read(1000) CompareFiles = StrComp(Str1, Str2, 0) If CompareFiles <> 0 Then CompareFiles = True Exit Do End If Loop File1.Close() File2.Close() End Function Return value: The function returns 0 or False if the two files are identical, otherwise True. Example: File1 = “C:\countries\apple1.jpg” File2 = “C:\countries\apple3.jpg” If CompareFiles(File1, File2) = False Then MsgBox “Files are identical.” Else MsgBox “Files are different.” End If    Source: Mercury Forum’s KB articles
1 comment
Read more

CreateImageFromClipBoard using QTP

By
'-------------------------------------------------------------------------' Method : CreateImageFromClipBoard' Author : Jai Purpose : It gets the clipboard image and convert as a image file.' Parameters: FileName - String, contains the BMP file name' iIndex - Integer, contains the Worksheet index' Returns : String. The replaced file name it gives.' Caller : - Nil' Calls : - Nil' ------------------------------------------------------------------------- Sub CreateImageFromClipBoard(sFileName) Dim wshShell,ShellReturnCode, sCmdExec Set WshShell = WScript.CreateObject("WScript.Shell") sCmdExec = "D:\autostuff\i_view32.exe /silent /clippaste /convert="& sFileName ShellReturnCode = WshShell.Run(sCmdExec, 1, True) End Sub
Post a Comment
Read more