1、以下为 QuickTest 和 Robot 都适用函数获取当前日期Public Function Get_Data()Dim currentDatecurrentDate = DateGet_Data = currentDateEnd Function获取当前时间Public Function Get_Time()Dim currentTimecurrentTime = TimeGet_Time = currentTimeEnd Function随机函数生成输入值：生成值范围 ij返回值：随机数Public Function Get_RandNum(fromNum,toNum)If (from
2、NumtoNum thenMsgBox “起始值必须小于结束值“ElseDim RunTimeRandomize RunTime = Int(10 * Rnd) + 1) Dim MyValue,iFor i = 1 To RunTimeRandomize MyValue = Int(toNum - fromNum + 1) * Rnd) + (fromNum)NextGet_randNum=MyValueEnd IfEnd Function值交换函数Public Sub swap(byref a,byref b)Dim cc = aa = bb = cEnd Sub 是否是质数函数是质数返回
3、 true，否则返回 falseFunction IsPrimeNumber(num)Dim i,flagflag = trueIf num = 1 Thenflag = FalseElseIf num “) ThenMail.Attachments.Add(Attachment)End IfMail.Sendol.QuitSet Mail = NothingSet ol = NothingEnd Function去掉字符串中的重复项Function NoRepeat(Inp,Sp)Dim aa,flag,words,length,i,j,k,sp1,sp2,ccaa = InpDo flag
4、 = False words = Split(aa,Sp)length = UBound(words)For i = 0 To (length -1)sp1 = words(i)For j = (i+1) To lengthsp2 = words(j)If sp1 = sp2 Thenflag = Trueaa = “For k = 0 To (j-1)aa = aa DBQ=“ & DBlocationset record = createobject(“adodb.recordset“)sql=“select * from “ & TableNamerecord.open sql,conD
5、Oif(record(“name“)=Value)thennum=num+1end Ifrecord.MoveNextloop until record.eof=Truerecord.closeset record=Nothing con.closeset con=NothingIf num = 0 ThenAccess_GetCount = 0Else Access_GetCount = numEnd If End Function按 ASCII 码值冒泡排序Function BubbleSort(VString,Spl,Func)Dim Str,StrLength,i,jStr = Spl
6、it(VString,Spl)StrLength = UBound(Str) + 1For i = 1 To (StrLength-1)For j = (i+1) To StrLengthIf Func = 1 thenIf Asc(Str(i-1) Asc(Str(j-1) ThenCall Swap(Str(i-1),Str(j-1)End If End IfNextNextj = “For i = 1 To StrLengthj = j & Str(i-1) & SplNextj = Left(j,(StrLength * 2 -1)BubbleSort = jEnd Function以
7、下为仅 QuickTest 适用函数让 QTP 运行时保持最小化Public Sub QTP_Small()Dim objQTPWinSet objQTPWin = GetObject(“ , “QuickTest.Application“)objQTPWin.WindowState = “Minimized“Set objQTPWin = NothingEnd Sub恢复 QTP 窗口Public Sub QTP_Big()Dim objQTPWinSet objQTPWin = GetObject(“ , “QuickTest.Application“)objQTPWin.WindowSt
8、ate = “Restored“Set objQTPWin = NothingEnd Sub写文件函数(追加)输入值：写入内容Public Function QTP_WriteFile(pathway,words) Dim fileSystemObj,fileSpec,logFile,waySet fileSystemObj = CreateObject(“Scripting.FileSystemObject“)fileSpec = pathway Set logFile = fileSystemObj.OpenTextFile(fileSpec, 8, true) logFile.Write
9、Line (CStr(words)logFile.CloseSet logFile = NothingEnd Function写文件函数(改写)输入值：写入内容Public Function QTP_WriteFile_Change(pathway,words) Dim fileSystemObj,fileSpec,logFile,waySet fileSystemObj = CreateObject(“Scripting.FileSystemObject“)fileSpec = pathway Set logFile = fileSystemObj.OpenTextFile(fileSpec
10、, 2, true) logFile.WriteLine (CStr(words)logFile.CloseSet logFile = NothingEnd Function读 Excel 文件元素Public Function QTP_Read_Excel(pathway,sheetname,x,y)Dim srcData,srcDoc,retset srcData = CreateObject(“Excel.Application“)srcData.Visible = Trueset srcDoc = srcData.Workbooks.Open(pathway)srcDoc.Worksh
11、eets(sheetname).Activateret = srcDoc.Worksheets(sheetname).Cells(x,y).valuesrcData.Workbooks.CloseWindow(“text:=Microsoft Excel“).CloseQTP_Read_Excel = retEnd Function写 Excel 文件元素并保存退出Public Function QTP_Write_Excel(pathway,sheetname,x,y,content)Dim srcData,srcDoc,sp1,sp2,num,use,a1,a2,a3set srcData
12、 = CreateObject(“Excel.Application“)srcData.Visible = Trueset srcDoc = srcData.Workbooks.Open(pathway)srcDoc.Worksheets(sheetname).ActivatesrcDoc.Worksheets(sheetname).Cells(x,y).value = content sp1 = Split(pathway,“.“) sp2 = Split(sp1(0),“) num = UBound(sp2) use = sp2(num) Set a1 = Description.Crea
13、te() a1(“text“).value=“Microsoft Excel - “ + use + “.xls“ a1(“window id“).value=“0“ Set a3 = Description.Create() a3(“Class Name“).value=“WinObject“ a3(“text“).value= use + “.xls“ Window(a1).WinObject(a3).Type micCtrlDwn + “s“ + micCtrlUpDim WshShellSet WshShell=CreateObject(“Wscript.Shell“)WshShell
14、.SendKeys “s“wait(1)srcData.Workbooks.CloseSet srcDoc = nothingWindow(“text:=Microsoft Excel“).CloseEnd Function定时停留弹出框函数Sub QTP_Msgbox(Value,waitTime,Title)Dim WshShellSet WshShell = CreateObject(“WScript.Shell“) WshShell.Popup Value, waitTime, TitleSet WshShell = nothingEnd Sub改变 Excel 的单元格颜色Publi
15、c Function QTP_Change_Color(pathway,sheetname,x,y,color)Dim srcData,srcDoc,sp1,sp2,num,use,a1,a2,a3set srcData = CreateObject(“Excel.Application“)srcData.Visible = Trueset srcDoc = srcData.Workbooks.Open(pathway)srcDoc.Worksheets(sheetname).ActivateIf color = “red“ Then srcDoc.Worksheets(sheetname).
16、Cells(x,y).Interior.color=vbredElseIf color = “green“ ThensrcDoc.Worksheets(sheetname).Cells(x,y).Interior.color=vbgreenElseMsgBox “输入的颜色参数不正确，只接收“red“和“green“End IfDim WshShellSet WshShell=CreateObject(“Wscript.Shell“)WshShell.SendKeys “s“wait(1)srcData.Workbooks.CloseSet srcDoc = nothingWindow(“te
17、xt:=Microsoft Excel“).CloseEnd Function捕获当前屏幕（截图）Public Function QTP_Capture(pathway)Dim datestampDim filenamedatestamp = Now() filename = Environment(“TestName“)&“_“&datestamp&“.png“ filename = Replace(filename,“/“,“) filename = Replace(filename,“:“,“)filename = pathway + “ + “&filename Desktop.Cap
18、tureBitmap filenameReporter.ReportEvent micFail,“image“,“ End FunctionQuickTestPlus 帮助文件对于 Excel 库函数 仅 QTP 适用Dim ExcelApp As Excel.ApplicationDim excelSheet As Excel.worksheetDim excelBook As Excel.workbookDim fso As Scripting.FileSystemObjectFunction CreateExcel() As Excel.ApplicationDim excelSheet
19、 As Excel.worksheetSet ExcelApp = CreateObject(“Excel.Application“) Create a new excel ObjectExcelApp.Workbooks.AddExcelApp.Visible = TrueSet CreateExcel = ExcelAppEnd FunctionSub CloseExcel(ExcelApp)Set excelSheet = ExcelApp.ActiveSheetSet excelBook = ExcelApp.ActiveWorkbookSet fso = CreateObject(“
20、Scripting.FileSystemObject“)On Error Resume Nextfso.CreateFolder “C:Temp“fso.DeleteFile “C:TempExcelExamples.xls“excelBook.SaveAs “C:TempExcelExamples.xls“ExcelApp.QuitSet ExcelApp = NothingSet fso = NothingErr = 0On Error GoTo 0End SubFunction SaveWorkbook(ExcelApp, workbookIdentifier, path) As Str
21、ingDim workbook As Excel.workbookOn Error Resume NextSet workbook = ExcelApp.Workbooks(workbookIdentifier)On Error GoTo 0If Not workbook Is Nothing ThenIf path = “ Or path = workbook.FullName Or path = workbook.Name Thenworkbook.SaveElseSet fso = CreateObject(“Scripting.FileSystemObject“)If InStr(pa
22、th, “.“) = 0 Thenpath = path & “.xls“End IfOn Error Resume Nextfso.DeleteFile pathSet fso = NothingErr = 0On Error GoTo 0workbook.SaveAs pathEnd IfSaveWorkbook = 1ElseSaveWorkbook = 0End IfEnd FunctionSub SetCellValue(excelSheet, row, column, value)On Error Resume NextexcelSheet.Cells(row, column) =
23、 valueOn Error GoTo 0End SubFunction GetCellValue(excelSheet, row, column)value = 0Err = 0On Error Resume NexttempValue = excelSheet.Cells(row, column)If Err = 0 Thenvalue = tempValueErr = 0End IfOn Error GoTo 0GetCellValue = valueEnd FunctionFunction GetSheet(ExcelApp, sheetIdentifier) As Excel.wor
24、ksheetOn Error Resume NextSet GetSheet = ExcelApp.Worksheets.Item(sheetIdentifier)On Error GoTo 0End FunctionFunction InsertNewWorksheet(ExcelApp, workbookIdentifier, sheetName) As Excel.worksheetDim workbook As Excel.workbookDim worksheet As Excel.worksheetIn case that the workbookIdentifier is emp
25、ty we will work on the active workbookIf workbookIdentifier = “ ThenSet workbook = ExcelApp.ActiveWorkbookElseOn Error Resume NextErr = 0Set workbook = ExcelApp.Workbooks(workbookIdentifier)If Err “ Thenworksheet.Name = sheetNameEnd IfSet InsertNewWorksheet = worksheetEnd FunctionFunction CreateNewW
26、orkbook(ExcelApp)Set NewWorkbook = ExcelApp.Workbooks.Add()Set CreateNewWorkbook = NewWorkbookEnd FunctionFunction OpenWorkbook(ExcelApp, path)On Error Resume NextSet NewWorkbook = ExcelApp.Workbooks.Open(path)Set OpenWorkbook = NewWorkbookOn Error GoTo 0End FunctionSub ActivateWorkbook(ExcelApp, wo
27、rkbookIdentifier)On Error Resume NextExcelApp.Workbooks(workbookIdentifier).ActivateOn Error GoTo 0End SubSub CloseWorkbook(ExcelApp, workbookIdentifier)On Error Resume NextExcelApp.Workbooks(workbookIdentifier).CloseOn Error GoTo 0End SubFunction CompareSheets(sheet1, sheet2, startColumn, numberOfC
28、olumns, startRow, numberOfRows, trimed) As BooleanDim returnVal As BooleanreturnVal = TrueIf sheet1 Is Nothing Or sheet2 Is Nothing ThenCompareSheets = FalseExit FunctionEnd IfFor r = startRow to (startRow + (numberOfRows - 1)For c = startColumn to (startColumn + (numberOfColumns - 1)Value1 = sheet1
29、.Cells(r, c)Value2 = sheet2.Cells(r, c)If trimed ThenValue1 = Trim(Value1)Value2 = Trim(Value2)End IfIf Value1 Value2 ThenDim cell As Excel.Rangesheet2.Cells(r, c) = “Compare conflict - Value was “ & Value2 & “, Expected value is “ & Value1 & “.“Set cell = sheet2.Cells(r, c)cell.Font.Color = vbRedre
30、turnVal = FalseEnd IfNextNextCompareSheets = returnValEnd Function写入 word 文件Sub QTP_WriteWord(pathway,content)Dim oWord,oRange,oDocSet oWord = CreateObject(“Word.Application“)oWord.documents.open pathway,forwriting, TrueSet oDoc = oWord.ActiveDocumentSet oRange = oDoc.contentoRange.insertafter contentoWord.ActiveDocument.Save Dim WshShell Set WshShell=CreateObject(“Wscript.Shell“) WshShell.SendKeys “s“ wait(1)oWord.Application.Quit True Set oRange = Nothing Set oDoc = Nothing Set oWord = NothingEnd Sub
