我常用的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