参考：http://zjjlover.blog.163.com/blog/static/1732090412010101210204549/
常用的Object对象
'文件操作 CreateObject("Scripting.FileSystemObject") '剪切板 Mercury.Clipboard 'vbs脚本环境 wscript.shell '操作excel Excel.Application 操作数据库 ADODB.Connection
'邮箱
Outlook.Application
'qtp
QuickTest.Application
1、关闭进程
function killprocess(proname) Dim wmi,processlist Set wmi=GetObject("winmgmts:") set processlist = wim.execquery("select * from win32_process where name="&chr(34)&proname&chr(34)) if not processlist.count="0" then systemUtil.CloseProcessByName proname End if set processlist = nothing set wmi = nothing End Function
[] 有时会发现上述代码无效，在查看任务管理器中的过程后，发现没有iexplore.exe”进程，那IE这个过程去了哪里？由于注册表的一个值设置，IE使用桌面过程Explore.exe”。因此，只要修改注册表相应的值，重启IE可以发现再次出现iexplore.exe”进程了。
具体做法如下：
注册表：
[HKEY_CURRENT_USER/Software/Microsoft/Windows/CurrentVersion/Explorer/BrowseNewProcess]
键值改为：
BrowseNewProcess='yes'
2、vbs调用qtp脚本(调用文件夹下所有子文件夹的脚本)
用vbs调qtp
自动执行指定的自动编写QTP脚本的VBS： '利用QTP本身的Quicktest.Application 对象 Dim qtApp Set qtApp = CreateObject ("Quicktest.Application") qtApp.Launch qtApp.Visible = True qtApp.Open "H:\QTP\QTPscript\Test1" qtApp.Test.Run ,True
例子2：
Dim folderObj,mainfoleder,subfolder,testname set folderObj = CreateObject("Scripting.FileSystemObject") mainfolder = folderObj.GetFolder("D:\test") set subfolder = mianfolder.SubFolders For each folder in subfolder wscript.sleep 1000 testname = folder.name path = "D:\test\"&testname if testname = ".svn" then else ExcQtpScript path,path&"\Res" End if killprocess("QTAutomationAgent.exe") killprocess("iexplore.exe") Next
Function ExcQtpScript(TestsPath,ResPath) KillProcess "QTPro.exe" wscript.sleep 2000 Sim qtApp,qtTest,qtResultsOpt Set qtApp = CreateObject("QuickTest.Application") sflag = FindProcess("QtAutomationAgent.exe") if Ucase(sflag) = "TRUE" then Else set atApp = nothing wscript.sleep 2000 set atApp = CreateObject("QuickTest.Application") End if qtApp.Launch qtApp.Visible = true qtApp.Options.Run.ImageCaptureForTestResults = "OnError" qtApp.Options.Run.RunMode = "Fast" qtApp.Options.Run.ViewRusults = false qtApp.Open TestsPath,True qtTest.Settings.Run.InterationMode = "rngItrations" qtTest.Settings.Run.StartIteration = 1 qtTest.Setting.Run.EndIteration = 1 set qtRestultsOpt = CreateObject("QuickTest.RunResultsOptions") qtResultsOpt.ResultsLocation = ResPath qtTest.Close set qtRestultsOpt = nothing set qtTest = nothing set qtApp = nothing killprocess "QTPro.exe" End Function
Function FindProcess(byval processname) FindProcess = false set shell = CreateObject ("Wscript.shell") set shellResult = shell.Exec("TaskList") While Not ShellResult.StdOut.AtEndOfStream if Instr(Ucase(shellResult.StdOut.ReadLine),Ucase(processname)) then FindProcess = true exit function End if Wend End Function
3.操作数据库 参考：http://blog.csdn.net/zzzmmmkkk/article/details/5947390
'获取数据
Provider=OraOLEDB.Oracle.1;Persist Security Ino=False;User ID=test;;Password=test;Data Source=192.168.13.19 Dim Cnn '定义一个数据库连接串 Set Cnn = CreateObject("ADODB.Connection") Cnn.ConnectionString ="Provider=OraOLEDB.Oracle.1;Persist Security Info=False;User ID=test;Password=test;Data Source=31" Cnn.Open '打开数据库连接 If Cnn.State = 0 Then '判断数据库连接是否成功 Reporter.ReportEvent micFail, "testing", "连接数据库失败" else Reporter.ReportEvent micPass, "testing", "连接数据库成功" End If if Cnn.State<> 0 then Set Rs=CreateObject("ADODB.Recordset") '生成记录集对象 strsql ="Select * from t_sys_user" '从数据库中查询t_sys_user的所有记录 Rs.Open strsql ,Cnn,1,3 '执行sql语句，记录可以自由移动，单数记录处于只读模式 ydl=Rs("USER_ID") '取得字段为USER_ID的记录，游标定义在第一行，所以取得的是该字段所在行的第一行数据 msgbox ydl dim a a="1188" '该a的数据库可以从外部获取，可以是某个页面的某个值，拿来跟数据库中的值做比较 for i=1 to Rs.Recordcount '开始遍历数据库中所有的行数，Rs.Recordcount表示统计数据库表的总记录数 if Rs("USER_ID")=a then '将数据库中USER_ID字段的值与变量a进行挨个比较， msgbox "a在数据库中存在" exit for '如果找到记录a，则推出for循环 else Rs.MoveNext '如果数据库中的值与a不相等的话，那么在数据库中将游标移到下一行 end if next end if RS.close '关闭记录集 Set RS=nothing '释放对象 Cnn.Close '关闭数据连接 Set Cnn=nothing '释放对象
’更新或删除数据 Function UpdateData(byval strsql) Provider=OraOLEDB.Oracle.1;Persist Security Info=False;User ID=test;;Password=test;Data Source=192.168.13.19 Dim Cnn '定义一个数据库连接串 Set Cnn = CreateObject("ADODB.Connection") Cnn.ConnectionString =Provider Cnn.Open '打开数据库连接 If Cnn.State = 0 Then '判断数据库连接是否成功 Reporter.ReportEvent micFail, "testing", "连接数据库失败" else Reporter.ReportEvent micPass, "testing", "连接数据库成功" End If if Cnn.State<> 0 then Set Cmd=CreateObject("adodb.command") Cmd.ActiveConnection=Provider Cmd.CommandType =1 Cmd.CommandText=strsql '执行更新 Cmd.Execute end if Set Cmd.ActiveConnection=nothing '释放对象 Set Cmd=nothing '释放对象 Cnn.Close '关闭数据连接 Set Cnn=nothing '释放对象 End Function
4、获取剪切板
Function GetClipBoardText() set MyClipboard = CreateObject("Mercury.Clipboard") GetClipBoardText = MyClipboard.GetText set MyClipboard = notiong End Function 5、操作qtp
'让QTP运行时保持最小化 Function MinQtp() Dim objQTPWin Set bjQTPWin = GetObject("" , "QuickTest.Application") objQTPWin.WindowState = "Minimized" Set bjQTPWin = Nothing End Function '恢复QTP窗口 Function MaxQtp() Dim objQTPWin Set bjQTPWin = GetObject("" , "QuickTest.Application") objQTPWin.WindowState = "Restored" Set bjQTPWin = Nothing End Function
6、写txt文件
Function WriteTxt(byval strtxt) Const ForReading=1,ForWriting=2,ForAppending=8 Set fso = CreateObject("Scripting.FileSystemObject") set openfile=fso.OpenTextFile("C:/Users/luyime/Desktop/1.txt",ForAppending,true) openfile.WriteLine(CStr(strtxt)) openfile.Close set openfile=noting Set fso=nothing End Function '输入值：写入内容 Public Function QTP_WriteFile(pathway,words) Dim fileSystemObj,fileSpec,logFile,way Set fileSystemObj = CreateObject("Scripting.FileSystemObject") fileSpec = pathway Set logFile = fileSystemObj.OpenTextFile(fileSpec, 8, true) logFile.WriteLine (CStr(words)) logFile.Close Set logFile = Nothing End Function
'读指定文本文件指定行内容 Function ReadLine(pathway, rowcount) Dim fso,myfile,i,flag flag = 1 Set fso=CreateObject("scripting.FileSystemObject") If fso.FileExists(pathway) then Set myfile = fso.openTextFile(pathway,1,false) Else flag = 0 End If For i=1 to rowcount-1 If Not myfile.AtEndOfLine Then myfile.SkipLine End If Next If flag = 1 then If Not myfile.AtEndOfLine Then ReadLine = myfile.ReadLine Else ReadLine = "文本越界" End If myfile.close Else ReadLine = "文件不存在" End If End Function
修改指定内容
Function UpdateFile Dim fso,myfile,filepath,newfilepath filepath = "D:\111.txt" newfilepath = "D:\new_111.txt" flag = 1 set fso = CreateObject("wscripting.shell") if fso.FileExists(filepath) then set myfile = fso.OpenTextFile (filepath,1,false) if fso.FileExists(newfilepath) then fso.DeleteFile(newfilepath) '清空文件 end if set newfilepath = fso.CreateTextFile(newfilepath,false) else flag =0 end if '正则表达式 set regEx = new RegExp regEx.Pattern = "status.*" if flag =1 then do txt = myfile.ReadLine() if regEx.Test(txt) then temptxt = "status=init" newfile.WriteLine(temptxt) else txt = "status=init" '添加内容 newfile.WriteLine(txt) End if loop while(not myfile.AtendOfStream) end if fso.CopyFile newfilepath,filepath set myfile = Nothing set filepath = Nothing set newfilepath = Nothing set fso = Nothing End Function
7、操作excel
'读Excel文件元素 Public Function QTP_Read_Excel(pathway,sheetname,x,y) Dim srcData,srcDoc,ret set srcData = CreateObject("Excel.Application") srcData.Visible = True set srcDoc = srcData.Workbooks.Open(pathway) srcDoc.Worksheets(sheetname).Activate ret = srcDoc.Worksheets(sheetname).Cells(x,y).value srcData.Workbooks.Close Window("text:=Microsoft Excel").Close QTP_Read_Excel = ret End Function '写Excel文件元素并保存退出 Public Function QTP_Write_Excel(pathway,sheetname,x,y,content) Dim srcData,srcDoc,sp1,sp2,num,use,a1,a2,a3 set srcData = CreateObject("Excel.Application") srcData.Visible = True set srcDoc = srcData.Workbooks.Open(pathway) srcDoc.Worksheets(sheetname).Activate srcDoc.Worksheets(sheetname).Cells(x,y).value = content ' sp1 = Split(pathway,".") ' sp2 = Split(sp1(0),"\") ' num = UBound(sp2) ' use = sp2(num) ' Set a1 = Description.Create() ' 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" + micCtrlUp Dim WshShell Set WshShell=CreateObject("Wscript.Shell") WshShell.SendKeys "^s" wait(1) srcData.Workbooks.Close Set srcDoc = nothing Window("text:=Microsoft Excel").Close End Function
'excel超链接 Function ReportInformation(filename) Set ExcelObj = CreateObject("Excel.Application") ExcelObj.Workbooks.Add Set NewSheet = ExcelObj.Sheets.Item(1) NewSheet.Name = "Page Information" NewSheet.Cells(1,1).Value = "Tom" NewSheet.Cells(2,1).Value = "Sohu" NewSheet.Hyperlinks.Add NewSheet.Cells(1,1), "http://www.tom.com/" NewSheet.Hyperlinks.Add NewSheet.Cells(2,1), "http://www.sohu.com/" ExcelObj.ActiveWorkbook.SaveAs filename ExcelObj.Quit Set ExcelObj = Nothing End Sub call ReportInformation("d:\test.xls") End Function
8、截图
'捕获当前屏幕（截图） Public Function PrintScreen(pathway) MinQtp() Dim datestamp Dim filename datestamp = Now() filename = Environment("TestName")&"_"&datestamp&".png" filename = Replace(filename,"/","") filename = Replace(filename,":","") filename = pathway + "\" + ""&filename Desktop.CaptureBitmap filename End Function
9、发邮件
'发送电子邮件 Function SendMail(SendTo, Subject, Body, Attachment) Dim ol,mail 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