QTP- COmpare excel sheets

'Provide the File details here

xlfile1 = "C:\File1.xls"

xlfile2 = "C:\File2.xls"

resfile = "C:\ResFile.xls"

Res = ExcelCmp(xlfile1,xlfile2,resfile)

' Function to compare the two excel files

Public Function ExcelCmp(firstFile,secondFile,resultFile)

' Declaring varaibles 

 Dim  objExcel1,objExcel2,objSpread1,objSpread2

 Dim  strCount,x1,x2,y1,y2,maxR,maxC,DiffCount,PDiffCount,limit

 Dim  cf1,cf2,fOffset,resOffSet,sMsg

 Dim  returnVal 'As Boolean

 returnVal = False

 limit = 1

 ' Creates object of the two Excel files

 Set objExcel1 = CreateObject("Excel.Application")

 objExcel1.displayalerts = false

 Set objSpread1 = objExcel1.Workbooks.Open(firstFile)

 Set objSpread2 = objExcel1.Workbooks.Open(secondFile)

 Set resBook = objExcel1.Workbooks.Add

 resBook.Sheets(1).Name = "Result"

 Set resWorkSheet = resBook.WorkSheets("Result")

 'Preparing the Headers and details in the Result File

 resWorkSheet.Cells(1,1) = "This is a result file which highlights the differences between the Files ..."

 resWorkSheet.Cells(2,1) = "File 1 : " + firstFile

 resWorkSheet.Cells(3,1) = "File 2 : " + secondFile

 resWorkSheet.Cells(4,1) = "'==========================================================================================="

 resWorkSheet.Range(resWorkSheet.Cells(1,1), resWorkSheet.Cells(1,12)).Merge

 resWorkSheet.Range(resWorkSheet.Cells(2,1), resWorkSheet.Cells(2,12)).Merge

 resWorkSheet.Range(resWorkSheet.Cells(3,1), resWorkSheet.Cells(3,12)).Merge

 resWorkSheet.Range(resWorkSheet.Cells(4,1), resWorkSheet.Cells(4,12)).Merge



 resWorkSheet.Cells(6,1) = "Item Name"

 resWorkSheet.Cells(6,1).Font.Bold = TRUE

 resWorkSheet.Cells(6,2) = "Location"

 resWorkSheet.Cells(6,2).Font.Bold = TRUE

 resWorkSheet.Cells(6,3) = "Data in File 1"

 resWorkSheet.Cells(6,3).Font.Bold = TRUE

 resWorkSheet.Cells(6,4) = "Data in File 2"

 resWorkSheet.Cells(6,4).Font.Bold = TRUE

 resOffSet = 7

 ' Get the number of worksheets used

 strCount = objSpread1.Worksheets.Count

 DiffCount = 0

 PDiffCount = 0

 'MsgBox strCount 



 'Loop to identify the differences per worksheet

 For i = 1 To strCount

 'Get the row and column count of the first worksheet 

  Set objWorksheet1 = objSpread1.Worksheets(i)

  With objWorksheet1.UsedRange

   x1 = .Rows.Count

   y1 = .Columns.Count

  End With

  'MsgBox x1 & " >> " & y1

  For tOff = 1 to x1

   If  (objWorksheet1.Cells(tOff,1) <> "")Then

    fOffset = tOff

    Exit For

   End If

  Next

  'Get the row and column count of the the secound worksheet 

  Set objWorksheet2 = objSpread2.Worksheets(i)

  With objWorksheet2.UsedRange

   x2 = .Rows.Count

   y2 = .Columns.Count

  End With

  maxR = x1

  maxC = y1

  If maxR < style="color: rgb(0, 0, 255);">Then

   maxR = x2

  End If

  If maxC < style="color: rgb(0, 0, 255);">Then

   maxC = y2

  End If

  'Loop to find the differences between the two files (cell by cell )

  cf1 = ""

  cf2 = ""

  For c = 1 To maxC

   For r = 1 To (maxR+fOffset)

    On Error Resume Next

    cf1 = LTrim(RTrim(objWorksheet1.Cells(r,c).Value))

    cf2 = LTrim(RTrim(objWorksheet2.Cells(r,c).Value))

    PDiffCount = DiffCount

    If Isnumeric(cf1) And Isnumeric(cf2) Then

     If Abs(cf1-cf2) > limit Then

      DiffCount = DiffCount+1

     End If

    Else

     If cf1 <> cf2 Then

     DiffCount = DiffCount+1

     End If

    End If

   

    If DiffCount >= (PDiffCount+1) Then

     objWorksheet1.Cells(r,c).Interior.ColorIndex = 3

     objWorksheet2.Cells(r,c).Interior.ColorIndex = 3

     resWorkSheet.Cells(resOffSet,1) = objWorksheet1.Cells(fOffset,c).Value

     resWorkSheet.Cells(resOffSet,2).Formula = "=Address("&r&","&c&",4)"

     resWorkSheet.Cells(resOffSet,3) = objWorksheet1.Cells(r,c).Value

     resWorkSheet.Cells(resOffSet,4) = objWorksheet2.Cells(r,c).Value

     resOffSet = resOffSet + 1

    End If

   

    cf1 = ""

    cf2 = ""

   Next

  Next

 Next

 If DiffCount=0 Then

  sMsg = "No Errors Found !!!"

  returnVal = True

 Else

  resBook.SaveAs resultFile

  sMsg =  "Error in Validation : " & DiffCount & " Items Mismatches!!!" & vbLF & "Results File available at : " & resultFile

 End If



 resBook.Close

 objSpread1.Close

 objSpread2.Close



 objExcel1.displayalerts = True

 objExcel1.Quit

 Set objSpread1 = Nothing

 Set objSpread2 = Nothing

 Set objExcel1 = Nothing

 Set resBook = Nothing

Excelcmp = sMsg

End Function

QTP- FInd duplicate value in excel

See if it works for you !


Call excel_Error_Search("C:\Tests\error.xls","invalid credentials")

function excel_Error_Search(filepath,strtofind)

Set objExl = CreateObject("Excel.Application")
objExl.visible=true
Set objWorkBook = objExl.Workbooks.Open(filepath)
Set objSheet = objExl.Sheets("Sheet1")

'strtofind="duplicate_val"
With objSheet.UsedRange
Set str = .Find (strtofind)
For each str in objSheet.UsedRange

If str=strtofind then’ compare with the expected data
'msgBox duplicate found

Reporter.reportevent 1,"Passed",strtofind

End If
Set str = .FindNext(str )
next
End With
objWorkBook.save
objWorkBook.close
set objExl=nothing

End Function

QTP - Scripts

'===============================
''''''''''''''''''Descriptive Program - To get the Gmail link - Start
'==============================
'
'SystemUtil.Run "C:\Program Files\Internet Explorer\iexplore.exe","","C:\Documents and Settings\shukr02","open"
''Browser("browser").Page("webcalendar").weblist("CalendarSource").Select "#1"
''
''wait 2
'set odesc =Description.Create()
'odesc("micclass").Value = "Link"
'Dim flag
'flag=false
''Set Links = browser("browser").Page("webcalendar").ChildObjects(odesc)
''Set Links = browser("browser").Page("webcalendar").ChildObjects(odesc)
'Set Links=Browser("Google").Page("Google").ChildObjects(odesc)
'
'For i=0 to Links.Count-1
'val = Links(i).getROproperty("text")
'If val="Gmail" Then
' Links(i).Click
' flag= true
'End If
'
'next
'
'If flag=true Then
'
'Reporter.ReportEvent micPass,"pass","Gmail link found"
'
'End If
'===============================
''''''''''''''''''Descriptive Program - To get the Gmail link - End
'==============================
'===============================
''''''''''''''''''Mouse Operation - Start
'==============================

'
'SystemUtil.Run "C:\Program Files\Internet Explorer\iexplore.exe","","C:\Documents and Settings\shukr02","open"
'Browser("Google").Page("Google").WebEdit("q").Set "wiki"
'Browser("Google").Page("Google").WebEdit("q").Submit
'Browser("Google").Page("wiki - Google Search").Sync
'Browser("Google").Page("wiki - Google Search").WebEdit("q").Set "WebPackage"
'
'Setting.WebPackage("ReplayType") = 2
'Browser("Google").Page("wiki - Google Search").WebEdit("q").Click ,, micRightBtn
'
'
'Set DeviceReplay = CreateObject("Mercury.DeviceReplay")
'
'DeviceReplay.KeyDown VK_CONTROL
'
'DeviceReplay.PressKey VK_A
'deviceReplay.SendString "Y umlaut: "
'
'DeviceReplay.KeyUp VK_CONTROL
'
'
'
'wait 2
'Browser("Google").Page("wiki - Google Search").WebEdit("q").Click ,, micLeftBtn
'wait 2
'
'Browser("Google").Page("wiki - Google Search").WebEdit("q").Click ,, micRightBtn
'
'Setting.WebPackage("ReplayType") = 1
'
'
'Browser("Google").Page("wiki - Google Search").WebEdit("q").Set ""

'===============================
''''''''''''''''''Mouse Operation Close
'==============================

'

'************************************************************************************************************************
'Description: - Migrate QTP Script from VA.x to VA+.x - START
'From QTP help ("Convert a Set of Tests from an Older QuickTest Version to the Current Version"
'example in Open Method of Application object):
'
'This example specifies a folder in which tests from an older QuickTest version are
'stored and then loops through each test in the folder (and its subfolders) to open
'each one and save it in the current version format.
'
'************************************************************************************************************************
'
'Dim qtApp 'As QuickTest.Application ' Declare the Application object variable
'Dim filesys
'Dim maindir
'Dim testCol
'Dim checkfolder
'
'' Create the QuickTest Professional object
'Set qtApp = CreateObject("QuickTest.Application")
'qtApp.Launch
'qtApp.Visible = True
'
'' Get the collection of test scripts
'Set filesys = CreateObject("Scripting.FileSystemObject")
'
'' TO DO: Sepecify the test script directory....
'Set maindir = filesys.GetFolder("C:\temp")
'Set testCol = maindir.SubFolders
'
'' Loop through each test in the collection
'For Each fl In testCol
'
' ' Verify the folder is a QTP test
' checkfolder = fl.Path & "\Action0"
' If (filesys.FolderExists(checkfolder)) Then ' The folder is a QTP test folder
'
' ' Convert test
' qtApp.Open fl.Path, False, False
'
' ' wscript.sleep 1000
'
' ' Save converted test
' qtApp.Test.Save
'
' End If
'Next
'
'qtApp.Quit
'
'' Release the File System Objects
'Set testCol = Nothing
'Set maindir = Nothing
'Set filesys = Nothing
'
'' Release the QuickTest Professional application object
'Set qtApp = Nothing
'************************************************************************************************************************
'Description: - Migrate QTP Script from VA.x to VA+.x - END
'
'************************************************************************************************************************


'************************************************************************************************************************
'Description: - Enviorment Variable -START
'
'************************************************************************************************************************

'
'
'
'
'
' Testing
'
' 25 Yellow Road
'
'
'
'
'
' Address2
'
' Testing
'
'
'
'
'
' Name
'
' John Brown
'
'
'
'
'
' testing
'
' 1-123-12345678
'
'
'
'

'Public qtp_App
'Set qtp_App = GetObject("","QuickTest.Application")
'qtp_App.Test.Environment.LoadFromFile("c:\Tests\test.xml")
'Msgbox qtp_App.Test.Environment.value("Testing")
'
'
'EnvXMLfile="c:\Tests\test.xml"
'Set qtp_App1= CreateObject("QuickTest.Application")
''qtp_App.launch
'qtp_App1.Test.Environment.LoadFromFile(EnvXMLfile)
'Frommail = qtp_App1.Test.Environment.value("Testing")
'msgbox Frommail
''qtp_App.Quit
''Set qtp_App=Nothing

'************************************************************************************************************************
'Description: - Enviorment Variable -END
'
'************************************************************************************************************************


'************************************************************************************************************************
'How can i make some rows colored in the data table? - START
'
'************************************************************************************************************************

Set xlApp=Createobject("Excel.Application")
set xlWorkBook=xlApp.workbooks.add
set xlWorkSheet=xlWorkBook.WorkSheets.add

'Every where on net it is given .WorkSheet instead of .WorkSheets and failing ... take care

xlWorkSheet.Range("A1:B10").interior.colorindex = 34 'Change the color of the cells
xlWorkSheet.Range("A1:A10").value="text" 'Will set values of all 10 rows to "text"
xlWorkSheet.Cells(1,1).value="Text" 'Will set the value of first row and first col

rowsCount=xlWorkSheet.Evaluate("COUNTA(A:A)") 'Will count the # of rows which have non blank value in the column A
colsCount=xlWorkSheet.Evaluate("COUNTA(1:1)") 'Will count the # of non blank columns in 1st row

xlWorkbook.SaveAs "C:\Test.xls"
xlWorkBook.Close
Set xlWorkSheet=Nothing
Set xlWorkBook=Nothing
set xlApp=Nothing

'************************************************************************************************************************
'How can i make some rows colored in the data table? - END
'
'************************************************************************************************************************

'************************************************************************************************************************
'How to connect database - START
''''''How to connect to a database?
'************************************************************************************************************************
' Const adOpenStatic = 3
' Const adLockOptimistic = 3
' Const adUseClient = 3
' Set objConnection = CreateObject("ADODB.Connection")
' Set objRecordset = CreateObject("ADODB.Recordset")
' objConnection.Open "DRIVER={Microsoft ODBC for Oracle};UID=;PWD="
' objRecordset.CursorLocation = adUseClient
' objRecordset.CursorType = adopenstatic
' objRecordset.LockType = adlockoptimistic
' ObjRecordset.Source="select field1,field2 from testTable"
' ObjRecordset.ActiveConnection=ObjConnection
' ObjRecordset.Open 'This will execute your Query
' If ObjRecordset.recordcount>0 then
' Field1 = ObjRecordset("Field1").Value
' Field2 = ObjRecordset("Field2").Value
' End if
'

'************************************************************************************************************************
'How to connect database - END
'************************************************************************************************************************

'Dim Exl_Obj
Set Exl_Obj = CreateObject("Excel.Application")
Exl_Obj.visible = True
Set WB_Obj_1 = Exl_Obj.Workbooks.Open("C:\Sat1.xls")
Set WB_Obj_2 = Exl_Obj.Workbooks.Open("C:\Sat2.xls")
Set WS_Obj_1 = WB_Obj_1.Worksheets(1)
Set WS_Obj_2 = WB_Obj_2.Worksheets(1)

'Set cell = WS_Obj_1.Cells

For Each cell In WS_Obj_1.UsedRange
if cell.Value <> WS_Obj_2.Range(Cell.Address).Value Then
cell.Interior.ColorIndex = 6
Else
cell.Interior.ColorIndex = 0
End if
Next
EXl_Obj.workbooks("Sat1.xls").save
EXl_Obj.workbooks("Sat1.xls").Close
EXl_Obj.workbooks("Sat2.xls").save
EXl_Obj.workbooks("Sat2.xls").Close
Exl_Obj.Application.Quit
Set Exl_Obj = nothing

'--------------------------------

QTP -Send email by Outlook

Call AttachHTMLAsMailContent("Team-Picasso-QA123", "shukr02", "alara01", "Automation Completed", "http://result.com")

Function AttachHTMLAsMailContent(sSendTo, sSendToCC, sSendToBCC, sSubject, sHtmlPath)

Dim objOutlook

Dim objOutlookMsg

Dim olMailItem

' Create the Outlook object and the new mail object.

Set objOutlook = CreateObject(Outlook.Application)

Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

' Define mail recipients

objOutlookMsg.To = sSendTo

objOutlookMsg.CC = sSendToCC

objOutlookMsg.BCC = sSendToBCC

' Body of the message

With objOutlookMsg

Set fso = CreateObject(Scripting.FileSystemObject)

Set ts = fso.OpenTextFile(sHtmlPath, 1)

strText = ts.ReadAll

.HTMLBody = strText

.Display

End With

' Send the message

objOutlookMsg.Send

Wait (3)

' Release the objects

Set objOutlook = Nothing

Set objOutlookMsg = Nothing

Set objOutlookMsg = Nothing

End Function

QTP - Get local Time zone

' Obtain local Time Zone bias from machine registry.
Set objShell = CreateObject("Wscript.Shell")
lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\" _
& "TimeZoneInformation\ActiveTimeBias")
If (UCase(TypeName(lngBiasKey)) = "LONG") Then
lngBias = lngBiasKey
ElseIf (UCase(TypeName(lngBiasKey)) = "VARIANT()") Then
lngBias = 0
For k = 0 To UBound(lngBiasKey)
lngBias = lngBias + (lngBiasKey(k) * 256^k)
Next
End If

QTP - .xlsx gives invalid file erroe while import

.xlsx was failing ...

SystemUtil.Run "C:\Program Files\Internet Explorer\iexplore.exe","","C:\Documents and Settings\shukr02","open"


searchString=Datatable.Value("col1",dtGlobalsheet)
datatable.ImportSheet "C:\Learning\lrn\ExternalSheet.xls","Sheet1","Action1"

Browser("Google").Page("Google").WebEdit("q").Set searchString
Browser("Google").Page("Google").WebButton("Google Search").Click
Browser("Google").Page("hello - Google Search").Sync
wait 2
Browser("Google").CloseAllTabs

****************to over come
an Excel workbook, by typing, "excel" in "Windows-Run" and save it as "Excel 97-2003 Workbook(*.xls), I am able to import the data Successfully.

then the code will work fine ...just rename file name

QTP - Excel Object Model

Application

Workbooks (Workbook) Worksheets (Worksheet) Charts (Chart) DocumentProperties (DocumentProperty) VBProject CustomViews (CustomView) CommandBars (CommandBar) HTMLProject PivotCaches (PivotCache) Styles (Style) Borders (Border) Font Interior Windows (Window) Panes (Pane) Names (Name) RoutingSlip PublishObjects (PublishObject) SmartTagOptions WebOptions

AddIns (AddIn) Answer AutoCorrect Assistant AutoRecover CellFormat COMAddIns (COMAddIn) Debug Dialogs (Dialog) CommandBars (CommandBar) ErrorCheckingOptions LanguageSettings Names (Name) Windows (Window) Panes (Pane) WorksheetFunction RecentFiles (RecentFile) SmartTagRecognizers SmartTagRecognizer Speech SpellingOptions FileSearch VBE ODBCErrors (ODBCError) OLEDBErrors (OLEDBError) DefaultWebOptions UsedObjects Watches Watch IRtdServer IRTDUpdateEvent