QTP 基础代码收集

1。 将bug添加到QC

Dim TDConnection
Set TDConnection = CreateObject("TDApiOle.TDConnection")
 
TDConnection.InitConnection "http://yovav/tdbin" ' URL for the DB
TDConnection.ConnectProject "TD76","bella","pino" ' Valid login information
 
If TDConnection.Connected Then
  MsgBox("Connected to " + chr (13) + "Server " + TDConnection.ServerName _
  + chr (13) +"Project " + TDConnection.ProjectName )
Else
  MsgBox("Not Connected")
End If
 
'Get the IBugFactory
Set BugFactory = TDConnection.BugFactory
 
'Add a new empty bug
Set Bug = BugFactory.AddItem (Nothing)
 
'fill the bug with relevant parameters
Bug.Status = "New"
Bug.Summary = "Connecting to TD"
Bug.Priority = "4-Very High" ' depends on the DB
Bug.AssignedTo = "admin" ' user that must exist in the DB's users list
Bug.DetectedBy = "admin" ' user that must exist in the DB's users list
 
'Post the bug to DB ( commit )
Bug.Post

2。 文件操作函数集：

' Creates a specified file and returns a TextStream object that can be used to read from or write to the file.
' Example of usage
' Set f = CreateFile("d:\temp\beenhere.txt", True)
' f.WriteLine Now
' f.Close
Function CreateFile(sFilename, bOverwrite)
    Set fso = CreateObject("scrīpting.FileSystemObject")
    Set CreateFile = fso.CreateTextFile(sFilename, bOverwrite)
End Function
 
' Opens a specified file and returns a TextStream object that can be used to read from, write to, or append to the file.
' iomode: 1 - ForReading, 2 - ForWriting, 8 - ForAppending
' Example of usage
' Set f = OpenFile("d:\temp\beenhere.txt", 2, True)
' f.WriteLine Now
' f.Close

Function OpenFile(sFilename, iomode, create)
    Set fso = CreateObject("scrīpting.FileSystemObject")
    Set ōpenFile = fso.OpenTextFile(sFilename, iomode, create)
End Function
 
' Appends a line to a file
' Example of usage
' AppendToFile "d:\temp\beenhere.txt", Now
Function AppendToFile(sFilename, sLine)
    Const ForAppending = 8
    If sFilename = "" Then
        sFilename = Environment("SystemTempDir") & "\QTDebug.txt"
    End If
    Set f = OpenFile(sFilename, ForAppending, True)
    f.WriteLine sLine
    f.Close
End Function
 
' Writes a line to a file.
' Destroys the current content of the file!
' Example of usage
' WriteToFile "d:\temp\beenhere.txt", Now
Function WriteToFile(sFilename, sLine)
    Const ForWriting = 2
    If sFilename = "" Then
        sFilename = Environment("SystemTempDir") & "\QTDebug.txt"
    End If
    Set f = OpenFile(sFilename, ForWriting, True)
    f.WriteLine sLine
    f.Close
End Function

3。 使用qtp发mail

' Example 1
Function SendMail(SendTo, Subject, Body, Attachment)
    Set ōl=CreateObject("Outlook.Application")
    Set Mail=ol.CreateItem(0)
    Mail.to=SendTo
    Mail.Subject=Subject
    Mail.Body=Body
    If (Attachment <> "") Then
        Mail.Attachments.Add(Attachment)
    End If
    Mail.Send
    ol.Quit
    Set Mail = Nothing
    Set ōl = Nothing
End Function
 
' Example 2
Function SendMail(SendFrom, SendTo, Subject, Body)
    Set ōbjMail=CreateObject("CDONTS.Newmail")
    ObjMail.From = SendFrom
    ObjMail.To = SendTo
    ObjMail.Subject = Subject
    ObjMail.Body = Body
    ObjMail.Send
    Set ōbjMail = Nothing
End Function
 

4。Excel操作函数集合：

Dim ExcellApp 'As Excel.Application
Dim excelSheet1 'As Excel.worksheet
Dim excelSheet2 'As Excel.worksheet
 
Set ExcelApp = CreateExcel()
 
'Create a workbook with two worksheets
ret = RenameWorksheet(ExcelApp, "Book1", "Sheet1", "Example1 Sheet Name")
ret = RenameWorksheet(ExcelApp, "Book1", "Sheet2", "Example2 Sheet Name")
ret = RemoveWorksheet(ExcelApp, "Book1", "Sheet3")
 
'SaveAs the work book
ret = SaveWorkbook(ExcelApp, "Book1", "D:\Example1.xls")
 
'Fill worksheets
Set excelSheet1 = GetSheet(ExcelApp, "Example1 Sheet Name")
Set excelSheet2 = GetSheet(ExcelApp, "Example2 Sheet Name")
For column = 1 to 10
    For row = 1 to 10
        SetCellValue excelSheet1, row, column, row + column
        SetCellValue excelSheet2, row, column, row + column
    Next
Next
 
'Compare the two worksheets
ret = CompareSheets(excelSheet1, excelSheet2, 1, 10, 1, 10, False)
If ret Then
    MsgBox "The two worksheets are identical"
End If
 
'Change the values in one sheet
SetCellValue excelSheet1, 1, 1, "Yellow"
SetCellValue excelSheet2, 2, 2, "Hello"
 
'Compare the worksheets again
ret = CompareSheets(excelSheet1, excelSheet2, 1, 10, 1, 10, True)
If Not ret Then
    MsgBox "The two worksheets are not identical"
End If
 
'save the workbook by index identifier
SaveWorkbook ExcelApp, 1, ""
 
'Close the Excel application
CloseExcel ExcelApp
 
' ****************************************** Function Library ***********************************************************

Dim ExcelApp 'As Excel.Application
Dim excelSheet 'As Excel.worksheet
Dim excelBook 'As Excel.workbook
Dim fso 'As scrīpting.FileSystemObject
 
' This function will return a new Excel Object with a default new Workbook
Function CreateExcel() 'As Excel.Application
    Dim excelSheet 'As Excel.worksheet
    Set ExcelApp = CreateObject("Excel.Application") 'Create a new excel Object
    ExcelApp.Workbooks.Add
    ExcelApp.Visible = True
    Set CreateExcel = ExcelApp
End Function
 
'This function will close the given Excel Object
'excelApp - an Excel application object to be closed
Sub CloseExcel(ExcelApp)
    Set excelSheet = ExcelApp.ActiveSheet
    Set excelBook = ExcelApp.ActiveWorkbook
    Set fso = CreateObject("scrīpting.FileSystemObject")
    On Error Resume Next
    fso.CreateFolder "C:\Temp"
    fso.DeleteFile "C:\Temp\ExcelExamples.xls"
    excelBook.SaveAs "C:\Temp\ExcelExamples.xls"
    ExcelApp.Quit
    Set ExcelApp = Nothing
    Set fso = Nothing
    Err = 0
    On Error GoTo 0
End Sub
 
'The SaveWorkbook method will save a workbook according to the workbookIdentifier
'The method will overwrite the previously saved file under the given path
'excelApp - a reference to the Excel Application
'workbookIdentifier - The name or number of the requested workbook
'path - the location to which the workbook should be saved
'Return "OK" on success and "Bad Workbook Identifier" on failure
Function SaveWorkbook(ExcelApp, workbookIdentifier, path) 'As String
    Dim workbook 'As Excel.workbook
    On Error Resume Next
    Set workbook = ExcelApp.Workbooks(workbookIdentifier)
    On Error GoTo 0
    If Not workbook Is Nothing Then
        If path = "" Or path = workbook.FullName Or path = workbook.Name Then
            workbook.Save
        Else
            Set fso = CreateObject("scrīpting.FileSystemObject")
 
            'if the path has no file extension then add the 'xls' extension
            If InStr(path, ".") = 0 Then
                path = path & ".xls"
            End If
 
            On Error Resume Next
            fso.DeleteFile path
            Set fso = Nothing
            Err = 0
            On Error GoTo 0
            workbook.SaveAs path
        End If
        SaveWorkbook = "OK"
    Else
        SaveWorkbook = "Bad Workbook Identifier"
    End If
End Function
 
'The SetCellValue method sets the given 'value' in the cell which is identified by
'its row column and parent Excel sheet
'excelSheet - the excel sheet that is the parent of the requested cell
'row - the cell's row in the excelSheet
'column - the cell's column in the excelSheet
'value - the value to be set in the cell
Sub SetCellValue(excelSheet, row, column, value)
    On Error Resume Next
    excelSheet.Cells(row, column) = value
    On Error GoTo 0
End Sub
 
'The GetCellValue returns the cell's value according to its row column and sheet
'excelSheet - the Excel Sheet in which the cell exists
'row - the cell's row
'column - the cell's column
'return 0 if the cell could not be found
Function GetCellValue(excelSheet, row, column)
    value = 0
    Err = 0
    On Error Resume Next
    tempValue = excelSheet.Cells(row, column)
    If Err = 0 Then
        value = tempValue
        Err = 0
    End If
    On Error GoTo 0
    GetCellValue = value
End Function
 
'The GetSheet method returns an Excel Sheet according to the sheetIdentifier
'ExcelApp - the Excel application which is the parent of the requested sheet
'sheetIdentifier - the name or the number of the requested Excel sheet
'return Nothing on failure
Function GetSheet(ExcelApp, sheetIdentifier) 'As Excel.worksheet
    On Error Resume Next
    Set GetSheet = ExcelApp.Worksheets.Item(sheetIdentifier)
    On Error GoTo 0
End Function
 
'The InsertNewWorksheet method inserts an new worksheet into the active workbook or
'the workbook identified by the workbookIdentifier, the new worksheet will get a default
'name if the sheetName parameter is empty, otherwise the sheet will have the sheetName
'as a name.
'Return - the new sheet as an Object
'ExcelApp - the excel application object into which the new worksheet should be added
'workbookIdentifier - an optional identifier of the worksheet into which the new worksheet should be added
'sheetName - the optional name of the new worksheet.
Function InsertNewWorksheet(ExcelApp, workbookIdentifier, sheetName) 'As Excel.worksheet
    Dim workbook 'As Excel.workbook
    Dim worksheet 'As Excel.worksheet
 
    'In case that the workbookIdentifier is empty we will work on the active workbook
    If workbookIdentifier = "" Then
        Set workbook = ExcelApp.ActiveWorkbook
    Else
        On Error Resume Next
        Err = 0
        Set workbook = ExcelApp.Workbooks(workbookIdentifier)
        If Err <> 0 Then
            Set InsertNewWorksheet = Nothing
            Err = 0
            Exit Function
        End If
        On Error GoTo 0
    End If
 
    sheetCount = workbook.Sheets.Count
    workbook.Sheets.Add , sheetCount
    Set worksheet = workbook.Sheets(sheetCount + 1)
 
    'In case that the sheetName is not empty set the new sheet's name to sheetName
    If sheetName <> "" Then
        worksheet.Name = sheetName
    End If
 
    Set InsertNewWorksheet = worksheet
End Function
 
'The RenameWorksheet method renames a worksheet's name
'ExcelApp - the excel application which is the worksheet's parent
'workbookIdentifier - the worksheet's parent workbook identifier
'worksheetIdentifier - the worksheet's identifier
'sheetName - the new name for the worksheet
Function RenameWorksheet(ExcelApp, workbookIdentifier, worksheetIdentifier, sheetName) 'As String
    Dim workbook 'As Excel.workbook
    Dim worksheet 'As Excel.worksheet
    On Error Resume Next
    Err = 0
    Set workbook = ExcelApp.Workbooks(workbookIdentifier)
    If Err <> 0 Then
        RenameWorksheet = "Bad Workbook Identifier"
        Err = 0
        Exit Function
    End If
    Set worksheet = workbook.Sheets(worksheetIdentifier)
    If Err <> 0 Then
        RenameWorksheet = "Bad Worksheet Identifier"
        Err = 0
        Exit Function
    End If
    worksheet.Name = sheetName
    RenameWorksheet = "OK"
End Function
 
'The RemoveWorksheet method removes a worksheet from a workbook
'ExcelApp - the excel application which is the worksheet's parent
'workbookIdentifier - the worksheet's parent workbook identifier
'worksheetIdentifier - the worksheet's identifier
Function RemoveWorksheet(ExcelApp, workbookIdentifier, worksheetIdentifier) 'As String
    Dim workbook 'As Excel.workbook
    Dim worksheet 'As Excel.worksheet
    On Error Resume Next
    Err = 0
    Set workbook = ExcelApp.Workbooks(workbookIdentifier)
    If Err <> 0 Then
        RemoveWorksheet = "Bad Workbook Identifier"
        Exit Function
    End If
    Set worksheet = workbook.Sheets(worksheetIdentifier)
    If Err <> 0 Then
        RemoveWorksheet = "Bad Worksheet Identifier"
        Exit Function
    End If
    worksheet.Delete
    RemoveWorksheet = "OK"
End Function
 
'The CreateNewWorkbook method creates a new workbook in the excel application
'ExcelApp - the Excel application to which an new Excel workbook will be added
Function CreateNewWorkbook(ExcelApp)
    Set NewWorkbook = ExcelApp.Workbooks.Add()
    Set CreateNewWorkbook = NewWorkbook
End Function
 
'The OpenWorkbook method opens a previously saved Excel workbook and adds it to the Application
'excelApp - the Excel Application the workbook will be added to
'path - the path of the workbook that will be opened
'return Nothing on failure
Function OpenWorkbook(ExcelApp, path)
    On Error Resume Next
    Set NewWorkbook = ExcelApp.Workbooks.Open(path)
    Set ōpenWorkbook = NewWorkbook
    On Error GoTo 0
End Function
 
'The ActivateWorkbook method sets one of the workbooks in the application as Active workbook
'ExcelApp - the workbook's parent excel Application
'workbookIdentifier - the name or the number of the workbook
Sub ActivateWorkbook(ExcelApp, workbookIdentifier)
    On Error Resume Next
    ExcelApp.Workbooks(workbookIdentifier).Activate
    On Error GoTo 0
End Sub
 
'The CloseWorkbook method closes an open workbook
'ExcelApp - the parent Excel application of the workbook
'workbookIdentifier - the name or the number of the workbook
Sub CloseWorkbook(ExcelApp, workbookIdentifier)
    On Error Resume Next
    ExcelApp.Workbooks(workbookIdentifier).Close
    On Error GoTo 0
End Sub
 
'The CompareSheets method compares between two sheets.
'if there is a difference between the two sheets then the value in the second sheet
'will be changed to red and contain the string:
'"Compare conflict - Value was 'Value2', Expected value is 'value2'"
'sheet1, sheet2 - the excel sheets to be compared
'startColumn - the column to start comparing in the two sheets
'numberOfColumns - the number of columns to be compared
'startRow - the row to start comparing in the two sheets
'numberOfRows - the number of rows to be compared
Function CompareSheets(sheet1, sheet2, startColumn, numberOfColumns, startRow, numberOfRows, trimed) 'As Boolean
    Dim returnVal 'As Boolean
    returnVal = True
 
    'In case that one of the sheets doesn't exists, don't continue the process
    If sheet1 Is Nothing Or sheet2 Is Nothing Then
        CompareSheets = False
        Exit Function
    End If
 
    'loop through the table and fill values into the two worksheets
    For r = startRow to (startRow + (numberOfRows - 1))
        For c = startColumn to (startColumn + (numberOfColumns - 1))
            Value1 = sheet1.Cells(r, c)
            Value2 = sheet2.Cells(r, c)
 
            'if 'trimed' equels True then used would like to ignore blank spaces
            If trimed Then
                Value1 = Trim(Value1)
                Value2 = Trim(Value2)
            End If
 
            'in case that the values of a cell are not equel in the two worksheets
            'create an indicator that the values are not equel and set return value
            'to False
            If Value1 <> Value2 Then
                Dim cell 'As Excel.Range
                sheet2.Cells(r, c) = "Compare conflict - Value was '" & Value2 & "', Expected value is '" & Value1 & "'."
                Set cell = sheet2.Cells(r, c)
                cell.Font.Color = vbRed
                returnVal = False
            End If
        Next
    Next
    CompareSheets = returnVal
End Function

5。WebTable功能函数集合：

' ************************************************** Function Library ********************************
 
' Registering both functions
RegisterUserFunc "WebTable", "ObjectsByMicClass", "ObjectsByMicClass"
RegisterUserFunc "WebTable", "ItemByKeyColumn", "ItemByKeyColumn"
 
' Function: ObjectsByMicClass
' Descrīption: Returns a collection of objects all the objects in a
' WebTable that have the specified MicClass
' Return Value: A Collection of Objects
' Arguments:
' Obj - Test Object (WebTable)
' micClass - The micClass of the objects to retrieve
'-----------------------------------------------------------------------------------------------------------
Function ObjectsByMicClass(Obj, micClass)
    Set Table = Obj
    ' Create a collection object to hold the items
    Set ōbjCollection = CreateObject("scrīpting.Dictionary")
    ' Go over all the cells in the table, and look for objects with the specified micClass
    For row=1 to Table.RowCount
        ColumnCount=Table.ColumnCount(row)
        For col=1 to ColumnCount
            For ItemIndex=0 to Table.ChildItemCount(row, col, micClass)-1
                Set childItem=Nothing
                Set childItem = Table.ChildItem(row, col, micClass, ItemIndex)
                If Not childItem is Nothing Then
                     ' If the cell contains a micClass object, add it to the collection
                     ItemKey = objCollection.Count + 1
                     objCollection.Add ItemKey, childItem
                End if
            Next
        Next
    Next
    Set ōbjectsbyMicClass = objCollection
End Function
 
 
' Function: ItemByKeyColumn
' Descrīption: Returns an item from a column, based on the value of a
' key column
' Return Value: Object
' Arguments:
' Obj - Test Object (WebTable)
' KeyColumnIndex - Index of the KeyColumn
' KeyColumnValue - Value to search for in the key column
' KeyItemIndex - Index of the value in the key column (if there is
'                        more than one). If 0, the first item will be used.
' TargetColumnIndex - Column from which to retrieve the target item
' micClass - The micClass of the target item
' TargetItemIndex - Index of the target item to retrieve (if there is
'                           more than one). If 0, the first item will be used.
' ------------------------------------------------------------------------------------------------------------------------------------
Function ItemByKeyColumn(Obj, KeyColumnIndex, KeyColumnValue, KeyItemIndex, TargetColumnIndex, micClass, TargetItemIndex)
    Table = Obj
    rowCount = Table.RowCount
 
    ' if TargetItemIndex was not specified, use 1 as deafult
    If TargetItemIndex < 1 Then
        TargetItemIndex = 1
    End If
    ' if KeyColumnIndex was not specified, use 1 as default
    If KeyItemIndex < 1 Then
        KeyItemIndex = 1
    End If
 
    ' look for KeyColumnValue in the key column to determine which
    ' row to retrieve the targe item from
    Row = 0
    foundIndex = 0
    While Row <= RowCount And foundIndex < KeyItemIndex
        Row = Row + 1
        CellData = Table.GetCellData(Row, KeyColumnIndex)
        If CellData = KeyColumnValue Then
           foundIndex = foundIndex + 1
        End If
    Wend
    If foundIndex < KeyItemIndex Then
        Exit Function
    End If
 
    ' Now that we know the row, retrieve the item (according to its micClass)
    ' from the target column.
    ChildItemsCount = Table.ChildItemCount(Row, TargetColumnIndex, micClass)
    If ChildItemsCount > =1 And ChildItemsCount >= TargetItemIndex Then
         Set GetItemByKeyColumn = Table.ChildItem(Row, TargetColumnIndex, micClass, TargetItemIndex-1)
    End If
End Function
 
 
' ************************************ Examples that use these functions *******************************************************
 
 
' Using the ItemByKeyColumn Function
Set ōbj = Browser("Table with objects").Page("Itenerary: Mercury Tours").WebTable("Acapulco to Zurich").ItemByKeyColumn(1,"FLIGHT",2,3,"WebElement",1)
msgbox obj.GetROProperty("innerhtml")
 
' Using the ObjectsByMicClass function
Set collection = Browser("Browser").Page("Page").WebTable("Table").ObjectsByMicClass("WebCheckBox")
For i=1 to collection.count
    If collection(i).GetROProperty("checked") Then
        collection(i).Set "OFF"
    Else
        collection(i).Set "ON"
    End If
Next