測試工程師中的VBS代碼

1、關閉進程的代碼，非常有用哦

Function ProcessClose(ProcessName)
 set MWI=GetObject("winmgmts:\\.\root\cimv2")
 set Pro=MWI.ExecQuery("select * from win32_process where name='" & ProcessName & "'")
 For Each ID In Pro
 ID.Terminate()
 next
End Function
on error resume next
ProcessClose "chromedriver.exe"
ProcessClose "chrome.exe"
ProcessClose "javaw.exe"
ProcessClose "firefox.exe"

2、啓動QTP的Vbs代碼，要自動運行最好用腳本控制哦

Dim qtapp
Dim qtoptions
Dim stros
Dim strusername
Dim fso
on error resume next
Set fso = CreateObject("scripting.filesystemobject")
if fso.FolderExists("C:\Program Files\Mercury Interactive\QuickTest Professional\Tests\Test1\Res1") then
fso.DeleteFolder "C:\Program Files\Mercury Interactive\QuickTest Professional\Tests\Test1\Res*",ture
end if
'創建QTP對象
Set qtapp = CreateObject("QuickTest.Application")
'啓動QTP
qtapp.Launch
qtapp.Visible =true
'打開測試
qtApp.Open "C:\Program Files\Mercury Interactive\QuickTest Professional\Tests\Test1",false
'設置環境變量
qtapp.Test.Environment.Value("Root") = "c:\"
qtapp.Test.Environment.Value("Password") = "MyPassword"
qtapp.Test.Environment.Value("Days") = 14
'設置測試結果環境變量
Set qtoptions = CreateObject("QuickTest.RunResultsOptions")
'設置運行結果存儲到臨時目錄
qtoptions.ResultsLocation ="C:\Program Files\Mercury Interactive\QuickTest Professional\Tests\Test1\Res1"
'運行測試
qtapp.Test.Run qtoptions,True
'保存測試
'qtapp.Test.Save
'退出qtp
'qtapp.Quit
3、本人用來監控網頁問題調用發送免費短消息通知的Vbs哦

Function  sendtext (IE,nameurl)
Dim SearchChar, MyPos
SearchChar = "org"
MyPos = Instr(1, nameurl, SearchChar)  
strname=Mid(nameurl,1,MyPos+2)
sendurl1="http://2.smsfx.sinaapp.com/send.php?tel=15281042117&pwd=15281042&aim=13438130133&text=Can't open "&strname&"   Details please check email"
sendurl4="http://2.smsfx.sinaapp.com/send.php?tel=15281042117&pwd=15281042&aim=15281042117&text=can't open "&strname&"   Details please check email"
IE.Navigate sendurl1
wait 1
IE.Navigate sendurl4
wait 1
End Function

4、Vbs也能發送Email哦，通常用來自動化報錯使用哦

sub sendmail(nameurl)
on error resume next
dim delpng
Set delpng = CreateObject("scripting.filesystemobject")
if delpng.FolderExists("C:\error.png") then
delpng.DeleteFolder "C:\error.png",ture
end If
set fso = nothing
Desktop.CaptureBitmap "c:\error.png" ,True
NameSpace = "http://schemas.microsoft.com/cdo/configuration/"
Set Email = CreateObject("CDO.Message")
Email.From = "[email protected]"
Email.To = "[email protected]"
Email.CC = "[email protected];[email protected]"
Email.Subject = "ERROR"&nameurl
Email.Textbody = "Please check the attachment!  Don't click next button  Addr:"&nameurl
Email.AddAttachment "C:\error.png"
With Email.Configuration.Fields
.Item(NameSpace&"sendusing") = 2
.Item(NameSpace&"smtpserver") = "smtp.126.com"
.Item(NameSpace&"smtpserverport") = 25
.Item(NameSpace&"smtpauthenticate") = 1
.Item(NameSpace&"sendusername") = "accountautotestforlink"
.Item(NameSpace&"sendpassword") = "password"
.Update
End With
Email.Send
Set Email=nothing
end sub

5、vbs操作excel，經常使用哦

Set ExcelApp = CreateObject("Excel.Application")   
Set ExcelWor = ExcelApp.Workbooks.Open("C:\Program Files\Mercury Interactive\QuickTest Professional\Tests\sheet2\Test.xls") 
Set ExcelShe = ExcelWor.Worksheets("Sheet1").UsedRange 
rowcount = ExcelShe.Rows.count     
columncount = ExcelShe.Columns.count   
If ExcelShe.Cells(1,1) = "" Then
Msgbox ExcelShe.Cells(1,1) 
End If               
ExcelShe.Cells(2,3)=123
ExcelApp.DisplayAlerts=True  
Set ExcelShe=Nothing
ExcelWor.Close(True)     
ExcelApp.Quit 

6、vbs通過ADO數據庫哦,

Dim cnn
Set cnn = Createobject ("ADODB.Connection")
cnn.ConnectionString="Provider=MSDAORA.1;Password=cdzstraffic;User ID=traffic_qs;Data Source=ORCL;Persist Security Info=True"
cnn.Open
If cnn.State = 0 Then
 Reporter.ReportEvent micFail,"testing","oracle數據庫連接失敗"
 else
 Reporter.ReportEvent micpass,"testing","oracle數據庫連接成功"
End If

If cnn.State<>0 Then
 Set Rs = Createobject ("ADODB.Recordset")
   strsql =  "select CI_CARPLATE from car_t_alarm"
   Rs.Open strsql,cnn,1,3
   ydl=Rs("CI_CARPLATE")
   msgbox ydl
   Rs.MoveNext
   RS.close
   Set cnn=nothing
  
End If