|
代码如下:
Public Sub RunTestSet(qcServer,qcDomain,qcProject,qcUser,qcPassword,tsFolderName,tSetName,runMode,runHostName,resultGetter)
'Dim qcServer 定义QC服务器地址
'Dim qcDomain 定义QC域的名称
'Dim qcProject 定义QC项目名称
'Dim qcUser 定义QC用户名称,必须保证这些用户有特定的执行权限
'Dim qcPassword 定义QC用户的密码
'Dim tsFolderName 定义测试集所在的路径(不包含"Root\")
'Dim tSetName 定义测试集的名称
'Dim runMode 定义运行模式:本地运行或代理运行
'Dim runHostName 定义代理运行的主机名称或IP地址,如果是本地运行则此参数自动失效
'Dim resultGetter 定义邮件接受人(列表),多人则以英文半角的逗号”,“分隔
'全局对象声明
'On Error Resume Next
Set Wshshell = CreateObject("Wscript.Shell")
Set TDC = CreateObject("TDApiOle80.TDConnection")
TDC.InitConnectionEx qcServer
TDC.Login qcUser,qcPassword
TDC.Connect qcDomain,qcProject
'声明测试集树、路径、测试实验室、测试集名等对象
Set tsTreeMgr = TDC.TestSetTreeManager
Set tsFolder = tsTreeMgr.NodeByPath("Root\"&Trim(tsFolderName))
Set tsList = tsFolder.FindTestSets(tSetName)
If tsList.Count > 1 Then
MsgBox "FindTestSets found more than one test set: refine search"
ElseIf tsList.Count < 1 Then
MsgBox "FindTestSets: test set not found"
End If
'报告当前运行测试集的测试集信息
Set theTestSet = tsList.Item(1)
'Wshshell.Popup "当前运行测试集ID为:"&theTestSet.ID&"测试集名称为:"&tSetName& "",1,"当前运行测试集为:",0
'判断运行模式:本机执行、代理执行,并且选择代理运行的执行机
If Trim(runMode) = "localrun" Then
Set Scheduler = theTestSet.StartExecution("")
Scheduler.RunAllLocally = True
Scheduler.Run
ElseIf Trim(runMode) = "remoterun" Then
' Wshshell.Popup "当前运行测试集ID为:"&theTestSet.ID&"测试集名称为:"&tSetName& "",1,"当前运行测试集为:",0
Set Scheduler = theTestSet.StartExecution("")
Scheduler.TdHostName = runHostName
Scheduler.Run
Else
Wshshell.Popup "调用接口错误,无此运行选项:【"&runMode&"】",1,"运行时错误:",0
Set tsList = Nothing
Set tsFolder = Nothing
Set tsTreeMgr = Nothing
Set TDC = Nothing
Set Wshshell = Nothing
Exit Sub
End If
Set execStatus = Scheduler.ExecutionStatus
While (RunFinished = False)
execStatus.RefreshExecStatusInfo "all",True
RunFinished = execStatus.Finished
Set EventList = execStatus.EventList
Wshshell.Popup "现在时间【"&CStr(Now)&"】",1,"执行结果通知:",0
Wscript.sleep 5000
Wend
Wshshell.Popup "执行全部完成于【"&CStr(Now)&"】",1,"执行结果通知:",0
TDC.Disconnect()
TDC.Logout()
TDC.ReleaseConnection()
'结束之后清空所有对象退出运行
Set TestSetTestsList = Nothing
Set TSTestFact = Nothing
Set theTestSet = Nothing
Set tsList = Nothing
Set tsFolder = Nothing
Set tsTreeMgr = Nothing
Set Wshshell = Nothing
Set TDC = Nothing
End Sub
Call RunTestSet("http://218.107.63.244:8080/qcbin/","DEFAULT","Notepad","username","password","notepad","test","remoterun","28.107.63.25","aaa@163.com")
为什么总是在执行到 Set Scheduler = theTestSet.StartExecution("")时候说activaX对象不能创建啊。 |
|