• 软件测试技术
  • 软件测试博客
  • 软件测试视频
  • 开源软件测试技术
  • 软件测试论坛
  • 软件测试沙龙
  • 软件测试资料下载
  • 软件测试杂志
  • 软件测试人才招聘
    暂时没有公告

字号: | 推荐给好友 上一篇 | 下一篇

软件测试工具QTP基础代码收集

发布: 2010-5-12 17:48 | 作者: 网络转载 | 来源: 领测软件测试 | 查看: 287次 | 进入软件测试论坛讨论

领测软件测试网

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

延伸阅读

文章来源于领测软件测试网 https://www.ltesting.net/

32/3<123>

关于领测软件测试网 | 领测软件测试网合作伙伴 | 广告服务 | 投稿指南 | 联系我们 | 网站地图 | 友情链接
版权所有(C) 2003-2010 TestAge(领测软件测试网)|领测国际科技(北京)有限公司|软件测试工程师培训网 All Rights Reserved
北京市海淀区中关村南大街9号北京理工科技大厦1402室 京ICP备2023014753号-2
技术支持和业务联系:info@testage.com.cn 电话:010-51297073

软件测试 | 领测国际ISTQBISTQB官网TMMiTMMi认证国际软件测试工程师认证领测软件测试网