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 ō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 |
版权声明：本文为博主原创文章，未经博主允许不得转载。