QTP基础代码收集《二》

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 &#333;l = Nothing
    End Function
   
    ' Example 2
    Function SendMail(SendFrom, SendTo, Subject, Body)
    Set &#333;bjMail=CreateObject("CDONTS.Newmail")
    ObjMail.From = SendFrom
    ObjMail.To = SendTo
    ObjMail.Subject = Subject
    ObjMail.Body = Body
    ObjMail.Send
    Set &#333;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&#299;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&#299;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&#299;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 &#333;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://my.oschina.net/zhangzhe/blog/482988

  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值