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

    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

    ArrayList Sort

    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

    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:FPdatatableInput _ 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(1)
    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 = 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

    CheckDate

    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()

    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") + 10
        y = Browser("FPC").Page("FPC").SlvWindow("Shell").SlvButton("btnSave").GetROProperty("y") + 10
        Browser("FPC").Page("FPC").WinObject("MicrosoftSilverlight").Click x,y
  • 相关阅读:
    golang闭包,传统斐波那契
    ubuntu 软件桌面图标创建
    Mysql系列-性能优化神器EXPLAIN使用介绍及分析
    Sklearn-GridSearchCV网格搜索
    sklearn逻辑回归(Logistic Regression)类库总结
    scikit-learn模块学习笔记(数据预处理模块preprocessing)
    Python中的高级数据结构
    Python进阶之“属性(property)”详解
    python模块之itertools
    python list有关remove的问题
  • 原文地址:https://www.cnblogs.com/goldenRazor/p/4825554.html
Copyright © 2020-2023  润新知