How to Automate Excel Automation in QTP with VBScript

Back to Menu

How to Automate Excel Automation in QTP with VBScript

Set XLobj=CreateObject("Excel.AppLication")
XLobj.Visible=True
XLpath="C:\Users\spice\Documents\Bluetooth\Desktop"
Set FSO=CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(XLpath)=False Then
XLobj.Workbooks.Add
Set Wbook=XLobj.Workbooks(1)
Set Wsheet=Wbook.Worksheets(1)
Wsheet.Name="ReportSheet"
Wsheet.cells(1,1)="Passed"
Wsheet.cells(2,1)="Failed"
Wsheet.cells(3,1)="Total TestCase"
Wsheet.cells(1,2)=3
Wsheet.cells(2,2)=4
Wsheet.cells(3,2)="=Sum(B1:B2)"
Wsheet.usedrange.rows(2).font.color=vbred
Wsheet.cells(5,1)="TC_ID"
Wsheet.cells(5,2)="TC_Name"
Wsheet.cells(5,3)="ModuleName"
Wsheet.cells(5,4)="Result"
Wsheet.cells(5,5)="SnapShot"
Wsheet.usedrange.rows(5).interior.color=vbGreen
Wsheet.usedrange.rows(5).font.color=vbred
Wsheet.usedrange.rows(5).font.bold=True
Wsheet.usedrange.Entirecolumn.Autofit()
FileName=Replace(Replace(Now,":","",1,-1,1),"-","",1,-1,1)
XL_FileName=XLpath&"\Result_"&FileName&".xlsx"
Wbook.SaveAs XL_FileName
 Else
Set Wbook=xlobj.Workbooks.Open(FileName)
 Set Wsheet=wbook.Worksheets("ReportSheet")
End If
reqcnt=wsheet.usedrange.rows.count
reqcnt=reqcnt+1
Wsheet.cells(reqcnt,1)="TC001"
Wsheet.cells(reqcnt,2)="TC_Login"
Wsheet.cells(reqcnt,3)="Login"
Wsheet.cells(reqcnt,4)="Failed"

Result=Wsheet.cells(reqcnt,4)
If UCase(Result)="FAILED"Then
Wsheet.cells(reqcnt,4).Font.Color=VBRed
Wsheet.cells(reqcnt,5)="SnapImage"
Fullpath=XLpath&"\"&FileName&".bmp"
'LogNameObj.CaptureBitmap Fullpath, True
Set Rngobj=Wsheet.range("E"&reqcnt)
Wsheet.Hyperlinks.add Rngobj,Fullpath
End If
Wsheet.usedrange.Entirecolumn.Autofit()
Wbook.Save
Wbook.Close
XLobj.Quit

Back to Menu