我常用的VBS方法(QTP)

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 = 1
    cStatus_Sum = 2
    cSum_Sum = 3
    cPass_Sum = 4
    cFail_Sum = 5
    cTime_Sum = 6

    cTestName = 1
    cStep = 2
    cStatus = 3
    cDetail = 4
    cTime = 5
    cPicName = 6
    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(1)

        End With
        With sNewBook.Worksheets(1)
        .Activate
        .Cells(1,cTestName_Sum).value = "TestName"
        .Cells(1,cStatus_Sum).value = "Status"
        .Cells(1,cSum_Sum).value = "Sum Num"
        .Cells(1,cPass_Sum).value = "Passed Num"
        .Cells(1,cFail_Sum).value = "Failed Num"
        .Cells(1,cTime_Sum).value = "TestTime"
        .Name = "Summary"
        .Rows(1).Font.Bold = True
        .Columns(cTestName_Sum).ColumnWidth= 25
         .Columns(cStatus_Sum).ColumnWidth= 10
        .Columns(cSum_Sum).ColumnWidth= 11
        .Columns(cPass_Sum).ColumnWidth= 11
        .Columns(cFail_Sum).ColumnWidth= 11
        .Columns(cTime_Sum).ColumnWidth= 15
        End With
        With sNewBook.Worksheets(2)
        .Activate
        .Cells(1,cTestName).value = "TestName"
        .Cells(1,cStep).value = "Step Object"
        .Cells(1,cStatus).value = "Status"
        .Cells(1,cDetail).value = "Result Detail"
        .Cells(1,cTime).value = "TestTime"
‘        .Cells(1,cPicName).value = "Capture Screen Name"
        .Name = "Passed Step"
        .Rows(1).Font.Bold = True
        .Columns(cTestName).ColumnWidth= 25
        .Columns(cStep).ColumnWidth= 40
        .Columns(cStatus).ColumnWidth= 8
          .Columns(cDetail).ColumnWidth= 50
        .Columns(cTime).ColumnWidth= 15
        .Columns(cPicName).ColumnWidth= 40
        End With
        With sNewBook.Worksheets(3)
        .Activate
        .Cells(1,cTestName).value = "TestName"
        .Cells(1,cStep).value = "Step Object"
        .Cells(1,cStatus).value = "Status"
        .Cells(1,cDetail).value = "Result Detail"
        .Cells(1,cTime).value = "TestTime"
        .Cells(1,cPicName).value = "Capture Screen Name"
        .Name = "Failed Step"
        .Rows(1).Font.Bold = True
        .Columns(cTestName).ColumnWidth= 25
        .Columns(cStep).ColumnWidth= 40
        .Columns(cStatus).ColumnWidth= 8
        .Columns(cDetail).ColumnWidth= 50
        .Columns(cTime).ColumnWidth= 15
        .Columns(cPicName).ColumnWidth= 40
        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 = 1
    cStatus_Sum = 2
    cSum_Sum = 3
    cPass_Sum = 4
    cFail_Sum = 5
    cTime_Sum = 6

    cTestName = 1
    cStep = 2
    cStatus = 3
    cDetail = 4
    cTime = 5
    cPicName = 6

    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(1)
    Set sNewSheetPass = sNewBook.Worksheets(2)
    Set sNewSheetFail = sNewBook.Worksheets(3)
    iLen = sNewSheet.UsedRange.Rows.count
    iLenPass = sNewSheetPass.UsedRange.Rows.count
    iLenFail = sNewSheetFail.UsedRange.Rows.count

    If Status = 0 Then
        With sNewSheetPass
            .Activate
            .Cells(iLenPass+1,cTestName).value = sTestName
            .Cells(iLenPass+1,cStep).value = sStep
            .Cells(iLenPass+1,cDetail).value = sDetail
            .Cells(iLenPass+1,cTime).value = now
            .Cells(iLenPass+1,cStatus).value = "Passed"
            .Cells(iLenPass+1,cStatus).Font.Color = vbGreen
            .Cells(iLenPass+1,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+1
            .Cells(iLen,cPass_Sum).value = .Cells(iLen,cPass_Sum).value+1
        Else
            .Cells(iLen+1,cTestName_Sum).value = sTestName
            .Cells(iLen+1,cSum_Sum).value = 1
            .Cells(iLen+1,cTime_Sum).value =now
            .Cells(iLen+1,cPass_Sum).value = 1
            .Cells(iLen+1,cFail_Sum).value = 0
            .Cells(iLen+1,cStatus_Sum).value = "Passed"
            .Cells(iLen+1,cStatus_Sum).Font.Color = vbGreen
            .Cells(iLen+1,cStatus_Sum).Font.Bold = True
        End If
        End With
    Else
        With sNewSheetFail
            .Activate
            .Cells(iLenFail+1,cTestName).value = sTestName
            .Cells(iLenFail+1,cStep).value = sStep
            .Cells(iLenFail+1,cDetail).value = sDetail
            .Cells(iLenFail+1,cTime).value = now
            .Cells(iLenFail+1,cStatus).value = "Failed"
            .Cells(iLenFail+1,cStatus).Font.Color = vbRed
            .Cells(iLenFail+1,cStatus).Font.Bold = True
‘            oExcel.Application.Visible = False
            .Cells(iLenFail+1,cPicName).value = CapturePic(sFolderPath,sStep)
Call   .Hyperlinks.Add(.Cells(iLenFail+1,cPicName),sFolderPath&"/"&.Cells(iLenFail+1,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+1
            .Cells(iLen,cFail_Sum).value = .Cells(iLen,cFail_Sum).value+1
            .Cells(iLen,cStatus_Sum).value = "Failed"
            .Cells(iLen,cStatus_Sum).Font.Color = vbRed
            .Cells(iLen,cStatus_Sum).Font.Bold = True
        Else
            .Cells(iLen+1,cTestName_Sum).value = sTestName
            .Cells(iLen+1,cSum_Sum).value = 1
            .Cells(iLen+1,cTime_Sum).value =now
            .Cells(iLen+1,cPass_Sum).value = 0
            .Cells(iLen+1,cFail_Sum).value = 1
            .Cells(iLen+1,cStatus_Sum).value = "Failed"
            .Cells(iLen+1,cStatus_Sum).Font.Color = vbRed
            .Cells(iLen+1,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()*100)
  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&"1"
  End If
  filename = filename&".png"
  picName = filename
  filename = pathway + "/" + ""&filename
  Desktop.CaptureBitmap filename
  CapturePic = picName
End Function

With Browser("DUI 02").Page("DUI 02").SlvWindow("Shell").SlvDialog("FileFlightFormView")

    iTimer=Timer
     Do
     Loop until .Exist  or (Timer-iTimer)>500
      If .Exist Then
     Reporter.ReportEvent micPass,"The system displays the fill form","dialog box displays successfully"
     .SlvButton("Select").Click
    end if

Option Explicit
Dim mArray()
ReDim mArray(10)

mArray(0)="0AABB"
mArray(1)="11abc"
mArray(2)="2ec11"
mArray(3)="aAACC"
mArray(4)="aAACC"
mArray(5)="aaaxx"
mArray(6)="AAAyb"
mArray(7)="AAdew"
mArray(8)="aaxew"
mArray(9)="ddddd"
mArray(10)="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)+1

  ‘check whether arraylist  length is more than two
   If leng < 2Then
       msgbox("No enough data in this arraylist.")
   End If
 For i=0 to Ubound(arraylist)-1

‘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+1),1) = 1 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+1)& " ."
         Exit function
     End If
 Next
end function

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}"

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

browser("title:="&PageTitleURL).Page("title:="&PageTitleURL).object.body.doScroll("scrollbarPageDown")

‘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
value=datatable.getsheet("sheet").getparameter("Para").valueByrow(1)
value=slvTable("table).getcelldata(1,"para")
‘Get Rowcount
count=datatable.getsheet("sheet").getrowcount
count=slvTable("table").rowcount

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 = 0 )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

Public Function currentdate()
    a = day(date)
    b = MonthName(month(date),true)
    c = right(Year(date),2)
    if cint(a) <10 then a = "0"&a
    currentdate  = a&"-"&b&"-"&c
End Function

MsgBox currentdate()

Set var_Object = Browser("FPC").Page("FPC").Object.body
    var_Object.doScroll("pageDown")
    x = Browser("FPC").Page("FPC").SlvWindow("Shell").SlvButton("btnSave").GetROProperty("x") + 10
    y = Browser("FPC").Page("FPC").SlvWindow("Shell").SlvButton("btnSave").GetROProperty("y") + 10
    Browser("FPC").Page("FPC").WinObject("MicrosoftSilverlight").Click x,y