正文
我常用的VBS方法(QTP)
提示：扫一扫查出行【扫一扫了解最新限行尾号】
复制提示
这些是4年前在HP用QTP做自动化测试时候总结的一些，现在贴出来，说不准以后会不会用到
当初花了2天时间写的一个自动生成的Excel Report
Public Function Report (status, objtype, text)
Dim TestName Reporter.Filter = rtEnableAll
Reporter.ReportEvent status, objtype, text
Reporter.Filter = rfDisableAll Call WExcel(status,objtype,text) End Function Function CreateExcel(sFolderPath)
Dim cTestName_Sum,cStatus_Sum,cSum_Sum,cPass_Sum,cFail_Sum,cTime_Sum
Dim cTestName,cStep,cStatus,cDetail,cTime,cPicName
Dim oFile,oExcel,sExcelPath,sNewBook,sNewSheet cTestName_Sum =
cStatus_Sum =
cSum_Sum =
cPass_Sum =
cFail_Sum =
cTime_Sum = cTestName =
cStep =
cStatus =
cDetail =
cTime =
cPicName =
Set oFile = CreateObject("Scripting.FileSystemObject")
Set oExcel = CreateObject("Excel.Application")
oExcel.Visible = False If not oFile.FolderExists(sFolderPath) Then
oFile.CreateFolder(sFolderPath)
End If sExcelPath = sFolderPath&"/Result.xls" If not oFile.FileExists(sExcelPath) Then
Set sNewBook = oExcel.Workbooks.Add
With sNewBook.Worksheets() End With
With sNewBook.Worksheets()
.Activate
.Cells(,cTestName_Sum).value = "TestName"
.Cells(,cStatus_Sum).value = "Status"
.Cells(,cSum_Sum).value = "Sum Num"
.Cells(,cPass_Sum).value = "Passed Num"
.Cells(,cFail_Sum).value = "Failed Num"
.Cells(,cTime_Sum).value = "TestTime"
.Name = "Summary"
.Rows().Font.Bold = True
.Columns(cTestName_Sum).ColumnWidth=
.Columns(cStatus_Sum).ColumnWidth=
.Columns(cSum_Sum).ColumnWidth=
.Columns(cPass_Sum).ColumnWidth=
.Columns(cFail_Sum).ColumnWidth=
.Columns(cTime_Sum).ColumnWidth=
End With
With sNewBook.Worksheets()
.Activate
.Cells(,cTestName).value = "TestName"
.Cells(,cStep).value = "Step Object"
.Cells(,cStatus).value = "Status"
.Cells(,cDetail).value = "Result Detail"
.Cells(,cTime).value = "TestTime"
' .Cells(1,cPicName).value = "Capture Screen Name"
.Name = "Passed Step"
.Rows().Font.Bold = True
.Columns(cTestName).ColumnWidth=
.Columns(cStep).ColumnWidth=
.Columns(cStatus).ColumnWidth=
.Columns(cDetail).ColumnWidth=
.Columns(cTime).ColumnWidth=
.Columns(cPicName).ColumnWidth=
End With
With sNewBook.Worksheets()
.Activate
.Cells(,cTestName).value = "TestName"
.Cells(,cStep).value = "Step Object"
.Cells(,cStatus).value = "Status"
.Cells(,cDetail).value = "Result Detail"
.Cells(,cTime).value = "TestTime"
.Cells(,cPicName).value = "Capture Screen Name"
.Name = "Failed Step"
.Rows().Font.Bold = True
.Columns(cTestName).ColumnWidth=
.Columns(cStep).ColumnWidth=
.Columns(cStatus).ColumnWidth=
.Columns(cDetail).ColumnWidth=
.Columns(cTime).ColumnWidth=
.Columns(cPicName).ColumnWidth=
End With
sNewBook.SaveAs sExcelPath
oExcel.Application.quit
Set sNewBook = Nothing
' CreateExcel = sExcelPath
End If End Function Function WExcel(Status,sStep,sDetail)
Dim cTestName_Sum,cStatus_Sum,cSum_Sum,cPass_Sum,cFail_Sum,cTime_Sum
Dim cTestName,cStep,cStatus,cDetail,cTime,cPicName
Dim oFile,oExcel,sExcelPath,sNewBook,sNewSheet
Dim iLen,iLenPass,iLenFail,sTestName,sFolderPath
sTestName = Environment.Value("TestName")
sFolderPath = "C:/FP_Results" cTestName_Sum =
cStatus_Sum =
cSum_Sum =
cPass_Sum =
cFail_Sum =
cTime_Sum = cTestName =
cStep =
cStatus =
cDetail =
cTime =
cPicName = CreateExcel(sFolderPath)
' msgbox sExcelPath Set oFile = CreateObject("Scripting.FileSystemObject")
Set oExcel = CreateObject("Excel.Application")
oExcel.Visible = False
sExcelPath = sFolderPath&"/result.xls" Set sNewBook = oExcel.Workbooks.Open(sExcelPath)
Set sNewSheet = sNewBook.Worksheets()
Set sNewSheetPass = sNewBook.Worksheets()
Set sNewSheetFail = sNewBook.Worksheets()
iLen = sNewSheet.UsedRange.Rows.count
iLenPass = sNewSheetPass.UsedRange.Rows.count
iLenFail = sNewSheetFail.UsedRange.Rows.count If Status = Then
With sNewSheetPass
.Activate
.Cells(iLenPass+,cTestName).value = sTestName
.Cells(iLenPass+,cStep).value = sStep
.Cells(iLenPass+,cDetail).value = sDetail
.Cells(iLenPass+,cTime).value = now
.Cells(iLenPass+,cStatus).value = "Passed"
.Cells(iLenPass+,cStatus).Font.Color = vbGreen
.Cells(iLenPass+,cStatus).Font.Bold = True
End With
With sNewSheet
.Activate
If sNewSheet.Cells(iLen,cTestName_Sum).value = sTestName Then
.Cells(iLen,cSum_Sum).value = .Cells(iLen,cSum_Sum).value+
.Cells(iLen,cPass_Sum).value = .Cells(iLen,cPass_Sum).value+
Else
.Cells(iLen+,cTestName_Sum).value = sTestName
.Cells(iLen+,cSum_Sum).value =
.Cells(iLen+,cTime_Sum).value =now
.Cells(iLen+,cPass_Sum).value =
.Cells(iLen+,cFail_Sum).value =
.Cells(iLen+,cStatus_Sum).value = "Passed"
.Cells(iLen+,cStatus_Sum).Font.Color = vbGreen
.Cells(iLen+,cStatus_Sum).Font.Bold = True
End If
End With
Else
With sNewSheetFail
.Activate
.Cells(iLenFail+,cTestName).value = sTestName
.Cells(iLenFail+,cStep).value = sStep
.Cells(iLenFail+,cDetail).value = sDetail
.Cells(iLenFail+,cTime).value = now
.Cells(iLenFail+,cStatus).value = "Failed"
.Cells(iLenFail+,cStatus).Font.Color = vbRed
.Cells(iLenFail+,cStatus).Font.Bold = True
' oExcel.Application.Visible = False
.Cells(iLenFail+,cPicName).value = CapturePic(sFolderPath,sStep)
Call .Hyperlinks.Add(.Cells(iLenFail+,cPicName),sFolderPath&"/"&.Cells(iLenFail+,cPicName).value,"","Capture screen when failed")
End With
With sNewSheet
.Activate
If sNewSheet.Cells(iLen,cTestName_Sum).value = sTestName Then
.Cells(iLen,cSum_Sum).value = .Cells(iLen,cSum_Sum).value+
.Cells(iLen,cFail_Sum).value = .Cells(iLen,cFail_Sum).value+
.Cells(iLen,cStatus_Sum).value = "Failed"
.Cells(iLen,cStatus_Sum).Font.Color = vbRed
.Cells(iLen,cStatus_Sum).Font.Bold = True
Else
.Cells(iLen+,cTestName_Sum).value = sTestName
.Cells(iLen+,cSum_Sum).value =
.Cells(iLen+,cTime_Sum).value =now
.Cells(iLen+,cPass_Sum).value =
.Cells(iLen+,cFail_Sum).value =
.Cells(iLen+,cStatus_Sum).value = "Failed"
.Cells(iLen+,cStatus_Sum).Font.Color = vbRed
.Cells(iLen+,cStatus_Sum).Font.Bold = True
end if
End With
End If sNewBook.Save
oExcel.Application.Quit
Set sNewBook = Nothing
Set oExcel = Nothing End Function Public Function CapturePic(pathway,sStep)
Dim datestamp
Dim picName
Dim filename
Dim ofile,ran
datestamp = Hour(Now)&Minute(Now)&Second(Now)
Set ofile = CreateObject("Scripting.FileSystemObject")
Randomize
ran = Int(Rnd()*)
filename = Environment("TestName")&"_"&sStep&datestamp&ran
filename = Replace(filename,"|","")
filename = Replace(filename,">","")
filename = Replace(filename,"<","")
filename = Replace(filename,"?","")
filename = Replace(filename,"*","")
filename = Replace(filename,"\","")
filename = Replace(filename,"/","")
filename = Replace(filename,":","")
If ofile.FileExists(pathway+"/"+""&filename&".png") Then
filename=filename&""
End If
filename = filename&".png"
picName = filename
filename = pathway + "/" + ""&filename
Desktop.CaptureBitmap filename
CapturePic = picName
End Function
With Object
With Browser("DUI 02").Page("DUI 02").SlvWindow("Shell").SlvDialog("FileFlightFormView")
iTimer=Timer
Do
Loop until .Exist or (Timer-iTimer)>
If .Exist Then
Reporter.ReportEvent micPass,"The system displays the fill form","dialog box displays successfully"
.SlvButton("Select").Click
end if
ArrayList Sort
Option Explicit
Dim mArray()
ReDim mArray() mArray()="0AABB"
mArray()="11abc"
mArray()="2ec11"
mArray()="aAACC"
mArray()="aAACC"
mArray()="aaaxx"
mArray()="AAAyb"
mArray()="AAdew"
mArray()="aaxew"
mArray()="ddddd"
mArray()="zzaAA1" ' Call function to check the order of the array
Call IsSorted(mArray) Function IsSorted(arraylist)
Dim leng,i 'get the length of the array
leng=Ubound(arraylist)+ 'check whether arraylist length is more than two
If leng < 2Then
msgbox("No enough data in this arraylist.")
End If
For i= to Ubound(arraylist)- 'The StrComp function compares two strings and returns a value that represents the result of the comparison.
'0 = vbBinaryCompare - Perform a binary comparison,1 = vbTextCompare - Perform a textual comparison If strcomp(arraylist(i),arraylist(i+),) = Then
' call Report (micFail, "Check the Sort of the array", "The array sort is not correct between "&arraylist(i)& " and "&arraylist(i+1)& " .")
msgbox "The array sort is not correct between "&arraylist(i)& " and "&arraylist(i+)& " ."
Exit function
End If
Next
end function
Send Key
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run "notepad"
WScript.Sleep 500
WshShell.AppActivate "Notepad"
Wshshell.SendKeys "%(123)"
Set shell=Createobject("WScript.Shell")
shell.SendKeys "{END}"
Run Action
RunAction "login [login_search]", oneIteration, , , url
RunAction "Search_Flight [login_search]", oneIteration, flight, "", ""
正则表达式
Dim itype
itype="^(3[0-1]|2[0-9]|1[0-9]|0[1-9])-(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)-\d{2}/[0-6]\d:[0-6]\d$"
msgbox isPatternMatch(itype,"30-Jan-04/00:00") Public Function isPatternMatch(patternType,inputData)
Dim myReg
If trim(inputData) = "" Then
isPatternMatch = true
Exit function
End If
Set myReg= New RegExp
'Set pattern
myReg.Pattern =patternType
' Set case insensitivity
myReg.IgnoreCase = True
' Set global applicability
myReg.Global = True
' Execute search
isPatternMatch=myReg.test(inputData)
End Function
PageScrollDown
browser("title:="&PageTitleURL).Page("title:="&PageTitleURL).object.body.doScroll("scrollbarPageDown")
Import from Excel
'datatable.ImportSheet "C:\FP\datatable\Input _ Initial018.xls" ,1 ,"Global"
rowcount = DataTable.GetSheet("Global").GetRowCount
'msgbox "step1:the number need to check is: "&rowcount
Get Value from Table
'Get value
value=datatable.getsheet("sheet").getparameter("Para").valueByrow()
value=slvTable("table).getcelldata(1,"para")
'Get Rowcount
count=datatable.getsheet("sheet").getrowcount
count=slvTable("table").rowcount
Connect Oracle
Dim Cnn
Set Cnn = CreateObject("ADODB.Connection")
Cnn.ConnectionString ="Provider=OraOLEDB.Oracle.1;Password=skyobj;Persist Security Info=True;User ID=skyobj;Data Source=TAEDFLP.airservices.eds.com"
Cnn.Open
If (Cnn.State = )Then
MsgBox "failed"
' Call Report(micFail, "Database connect testing", "Failed!")
'Reporter.ReportEvent micFail, "Database connect testing", "连接数据库失败"
Else
MsgBox "success"
' Call Report(micPass, "Database connect testing", "Success!")
'Reporter.ReportEvent micPass, "Database connect testing", "连接数据库成功"
end if
CheckDate
Public Function currentdate()
a = day(date)
b = MonthName(month(date),true)
c = right(Year(date),)
if cint(a) < then a = ""&a
currentdate = a&"-"&b&"-"&c
End Function MsgBox currentdate()
Click Save button （FP,silverligh)
Set var_Object = Browser("FPC").Page("FPC").Object.body
var_Object.doScroll("pageDown")
x = Browser("FPC").Page("FPC").SlvWindow("Shell").SlvButton("btnSave").GetROProperty("x") +
y = Browser("FPC").Page("FPC").SlvWindow("Shell").SlvButton("btnSave").GetROProperty("y") +
Browser("FPC").Page("FPC").WinObject("MicrosoftSilverlight").Click x,y
