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

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 :                         http://goessner.net/download/prj/jsonxml/j
Post a Comment
Read more

Read Outlook mail attachment and Body using Vb Script or QTP

By
Set olApp = CreateObject("Outlook.Application") Set olns = olApp.GetNameSpace("MAPI") Set ObjFolder = olns.GetDefaultFolder(6) j = 0 For each item1 in ObjFolder.Items        iattachCnt = item1.Attachments.Count     Print "Attachments Count: " & iattachCnt     For i = 1 to iattachCnt         Print "FileName :    " & item1.Attachments(i).FileName         Print "Display Name:   " & item1.Attachments(i).DisplayName         Print "Size: " & item1.Attachments(i).Size     Next     Print " Body : " & item1.body     Print "--------------------------------------Mail Num - " & j & " -----------------------------------------------"     j = j+1    Next
Post a Comment
Read more

Excel Sorting By Rows and Columns

By
Excel Sorting By Row: Const xlAscending = 1 Const xlNo = 2 Const xlSortRows = 2 Set objExcel = CreateObject(“Excel.Application”) objExcel.Visible = True Set objWorkbook = objExcel.Workbooks.Open(“C:\Jay\Docs1.xls”) Set objWorksheet = objWorkbook.Worksheets(1) objWorksheet.Cells(1,1).activate Set objRange = objExcel.ActiveCell.EntireRow objRange.Sort objRange, xlAscending, , , , , , xlNo, , , xlSortRows set objExcel=nothing Excel Sorting By Column : Const xlAscending = 1′represents the sorting type 1 for Ascending 2 for Desc Const xlYes = 1 Set objExcel = CreateObject(“Excel.Application”)’Create the excel object objExcel.Visible = True’Make excel visible Set objWorkbook = _ objExcel.Workbooks.Open(“C:\Jay\Docs1.xls”)’Open the document Set objWorksheet = objWorkbook.Worksheets(1)’select the sheet based on the index .. 1,2 ,3 … Set objRange = objWorksheet.UsedRange’which select the range of the cells has some data other than blank Set objRange2 = objExcel.Range
Post a Comment
Read more

How to Read or Select Context Menu or Right Click Menu using QTP.

By
Select The Item in Right Click Menu or Context Menu: Window("sampleWindow").WinMenu("MenuObjType:=1).Select"File;New" Here MenuObjtype can be 1 r 2 r 3 .......n Check wether the Item is Exist or Not: If Window("sampleWindow").WinMenu("MenuObjType:=1).GetItemProperty("1","Exist") Then   Msgbox"Exist" Else  Msgbox"Does Not Exist" End If                                         Or If Window("sampleWindow").WinMenu("MenuObjType:=1).GetItemProperty("File","Exist") Then   Msgbox"Exist" Else  Msgbox"Does Not Exist" End If Get the Items in Context Menu: For i = 1 to 10 Print  Window("sampleWindow").WinMenu("MenuObjType:=" & i).GetItemProperty("1","Label") Then Next
Post a Comment
Read more

How to Download a file using VbScript

By
Following is the code to download a file using Vbscript, without using QTP This code uses the HTMLDom and URLDownloadToFile method from urlmon API. Since VBScript does support calling Native API methods directly, here I am using  Excel macro to declare a function for the urlmon API and running the macro by Excel API from VBscript Step1: Create a new excel and open the visual basic editor, Insert Module and paste the following code the Module, save the excel file Private Declare Function URLDownloadToFile Lib “urlmon” Alias _                                            “URLDownloadToFileA” ( _                                            ByVal pCaller As Long, ByVal szURL As String, _                                            ByVal szFileName As String, _                                            ByVal dwReserved As Long, _                                            ByVal lpfnCB As Long) As Long Sub FileSave(strUrl, Des)     r = URLDownloadToFile(0, strUrl, Des, 0, a)
Post a Comment
Read more