测试工程师中的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