运行 测试集时出现错误 "ActiveX component can’t create object"
Getting error "ActiveX component can’t create object" when running testset
我正在尝试 运行 使用 VBScript 从 ALM 编写 UFT 脚本，但我在行中遇到错误：
set objScheduler = objTestSet.StartExecution ("").
Error:ActiveX component can’t create object
完整脚本：
' Script : Run the ALM/QC Test Sets
Dim objTDCon, objTreeMgr, objTestSetFolder, objTestSetList
Dim objTestSet, objScheduler, objExecStatus, objTestExecStatus
Dim strTestSetFolderPath, strTestSetName, strReportStatus, intCounter
'Declare the Test Folder, Test and Host you wish to run the test on
'Enter the URL to QC server
strQCURL = "http://126.144.32.655:8080/qcbin/"
'Enter Domain to use on QC server
strQCDomain = "DEFAULT"
'Enter Project Name
strQCProject = "Test"
'Enter the User name to log in and run test
strQCUser = "alm_user"
'Enter user password for the account above.
strQCPassword = "pass"
'Enter the path to the Test set folder
strTestSetFolderPath = "Root\UFT\"
'Enter the test set to be run
strTestSetName = "GUItest1"
'Enter the target machine to run test
strHostName=""
'Connect to Quality Center and login.
Set objTDCon = CreateObject("TDApiOle80.TDConnection")
'Make connection to QC server
objTDCon.InitConnectionEx strQCURL
'Login in to QC server
objTDCon.Login strQCUser, strQCPassword
'select Domain and project
objTDCon.Connect strQCDomain, strQCProject
'Select the test to run
Set objTreeMgr = objTDCon.TestSetTreeManager
Set objTestSetFolder = objTreeMgr.NodeByPath(strTestSetFolderPath)
Set objTestSetList = objTestSetFolder.FindTestSets (strTestSetName)
intCounter = 1
'find test set object
While intCounter <= objTestSetList.Count
Set objTestSet = objTestSetList.Item( intCounter)
If objTestSet.Name = strTestSetName Then
intCounter = objTestSetList.Count + 1
End If
intCounter = intCounter + 1
Wend
'Set the Host name to run on and run the test.
' // Getting Error here:"ActiveX component can't create object"
Set objScheduler = objTestSet.StartExecution ("")
' Set this empty to run local for automation run agent
objScheduler.RunAllLocally = True
'msgbox "Hostname passed"
'objScheduler.TdHostName = strHostName
objScheduler.Run
'Wait for the test to run to completion.
Set objExecStatus = objScheduler.ExecutionStatus
While objExecStatus.Finished = False
objExecStatus.RefreshExecStatusInfo "all", True
If objExecStatus.Finished = False Then
WScript.sleep 5
End If
Wend
'Below is example to determine if execution failed for error reporting.
strReportStatus = "Passed"
For intCounter = 1 To objExecStatus.Count
Set objTestExecStatus = objExecStatus.Item(intCounter )
'msgbox intCounter & " " & objTestExecStatus.Status
If Not ( Instr (1, Ucase( objTestExecStatus.Status ), Ucase ( "Passed" ) ) > 0 ) Then
strReportStatus = "Failed"
testsPassed = 0
Exit For
Else
testsPassed = 1
End If
Next
objTDCon.DisconnectProject
If (Err.Number > 0) Then
'MsgBox "Run Time Error. Unable to complete the test execution !! " &
Err.Description
WScript.Quit 1
ElseIf testsPassed >0 Then
'Msgbox "Tests Passed !!"
WScript.Quit 0
Else
'Msgbox "Tests Failed !!"
WScript.Quit 1
End If
这是我以前写的一个小 vbscript。它将从 ALM 执行特定测试。我已经发表评论以便于理解。
On Error Resume Next
Dim objExplorer
'' Getting ALM username
strUserName = InputBox("Please enter your ALM login name:", _
"ALM login name")
'' Getting ALM password
strPassword = InputBox("Please enter your ALM Password:", _
"ALM Password")
'' QTP/UFT script path
Dim Test_path
Test_path = "[QualityCenter] Subject\folder1\sub-folder\script(test) name"
Dim qtApp ''As QuickTest.Application ''Declare the Application object variable
Dim qtTest ''As QuickTest.Test ''Declare a Test object variable
Set qtApp = CreateObject("QuickTest.Application") ''Create the Application object
''Check if the application is not already Launched
If Not qtApp.Launched then
qtApp.Launch
Else
Wscript.Echo "UFT is already open." & vbCrLf & "Please close the UFT and run the script again."
WScript.Quit
End If
qtApp.Visible = False ''Make the QTP/UFT visible
'' Connecting to ALM
If Not qtApp.TDConnection.IsConnected Then
qtApp.TDConnection.Connect "ALM URL","Domain","Project", strUserName, strPassword,False
End If
If Err.Number <> 0 Then HandleError
'' Set QTP/UFT run options
qtApp.Options.Run.RunMode = "Fast"
qtApp.Options.Run.ViewResults = False
qtApp.Open Test_path, True ''Open the test in read-only mode
If Err.Number <> 0 Then HandleError
'' set run settings for the test
Set qtTest = qtApp.Test
qtTest.Run ''Run the test
qtTest.Close ''Close the test
qtApp.quit ''Close the QTP/UFT
Wscript.Echo "Test is completed." ''Comment this line if you don't want the messagebox
Set qtTest = Nothing ''Release the Test object
Set qtApp = Nothing ''Release the Application object
'*****************************************************************************************************************
' Error handler
'*****************************************************************************************************************
Sub HandleError()
If qtApp.Launched then
qtApp.Quit
End If
numerr = Err.number
abouterr = Err.description
If numerr <> 0 Then
Wscript.Echo "An Error has occurred! Error number " & numerr & " of the type '" & abouterr & "'. Please check the error and run the script again."
End If
WScript.Quit
End Sub
您可以使用任务计划程序来计划此脚本。
更新（基于评论）
要使测试集定期 运行，您可以将 Vbscript 与 ALM 的 OTA API 一起使用，并在预定时间使用 Windows 调度程序 运行。
set tdc = createobject("TDApiOle80.TDConnection")
tdc.InitConnectionEx "http://qcURL/qcbin/"
tdc.login "yourUserName","yourPassword"
tdc.Connect "yourDomain","yourProject"
Set objShell = CreateObject("WScript.Shell")
Set TSetFact = tdc.TestSetFactory
Set tsTreeMgr = tdc.TestSetTreeManager
Set tsFolder = tsTreeMgr.NodeByPath("Root\Formal Tests\YourTestDirectory")
Set tsList = tsFolder.FindTestSets("Your TestSet name. This is case sensitive!")
Set theTestSet = tsList.Item(1)
Set Scheduler = theTestSet.StartExecution("")
Scheduler.RunAllLocally = True
Scheduler.run
Set execStatus = Scheduler.ExecutionStatus
Do While RunFinished = False
execStatus.RefreshExecStatusInfo "all", True
RunFinished = execStatus.Finished
Set EventsList = execStatus.EventsList
For Each ExecEventInfoObj in EventsList
strNowEvent = ExecEventInfoObj.EventType
Next
For i= 1 to execstatus.count
Set TestExecStatusobj =execstatus.Item(i)
intTestid = TestExecStatusobj.TestInstance
Next
Loop
我正在尝试 运行 使用 VBScript 从 ALM 编写 UFT 脚本，但我在行中遇到错误：
set objScheduler = objTestSet.StartExecution ("").
Error:ActiveX component can’t create object
完整脚本：
' Script : Run the ALM/QC Test Sets
Dim objTDCon, objTreeMgr, objTestSetFolder, objTestSetList
Dim objTestSet, objScheduler, objExecStatus, objTestExecStatus
Dim strTestSetFolderPath, strTestSetName, strReportStatus, intCounter
'Declare the Test Folder, Test and Host you wish to run the test on
'Enter the URL to QC server
strQCURL = "http://126.144.32.655:8080/qcbin/"
'Enter Domain to use on QC server
strQCDomain = "DEFAULT"
'Enter Project Name
strQCProject = "Test"
'Enter the User name to log in and run test
strQCUser = "alm_user"
'Enter user password for the account above.
strQCPassword = "pass"
'Enter the path to the Test set folder
strTestSetFolderPath = "Root\UFT\"
'Enter the test set to be run
strTestSetName = "GUItest1"
'Enter the target machine to run test
strHostName=""
'Connect to Quality Center and login.
Set objTDCon = CreateObject("TDApiOle80.TDConnection")
'Make connection to QC server
objTDCon.InitConnectionEx strQCURL
'Login in to QC server
objTDCon.Login strQCUser, strQCPassword
'select Domain and project
objTDCon.Connect strQCDomain, strQCProject
'Select the test to run
Set objTreeMgr = objTDCon.TestSetTreeManager
Set objTestSetFolder = objTreeMgr.NodeByPath(strTestSetFolderPath)
Set objTestSetList = objTestSetFolder.FindTestSets (strTestSetName)
intCounter = 1
'find test set object
While intCounter <= objTestSetList.Count
Set objTestSet = objTestSetList.Item( intCounter)
If objTestSet.Name = strTestSetName Then
intCounter = objTestSetList.Count + 1
End If
intCounter = intCounter + 1
Wend
'Set the Host name to run on and run the test.
' // Getting Error here:"ActiveX component can't create object"
Set objScheduler = objTestSet.StartExecution ("")
' Set this empty to run local for automation run agent
objScheduler.RunAllLocally = True
'msgbox "Hostname passed"
'objScheduler.TdHostName = strHostName
objScheduler.Run
'Wait for the test to run to completion.
Set objExecStatus = objScheduler.ExecutionStatus
While objExecStatus.Finished = False
objExecStatus.RefreshExecStatusInfo "all", True
If objExecStatus.Finished = False Then
WScript.sleep 5
End If
Wend
'Below is example to determine if execution failed for error reporting.
strReportStatus = "Passed"
For intCounter = 1 To objExecStatus.Count
Set objTestExecStatus = objExecStatus.Item(intCounter )
'msgbox intCounter & " " & objTestExecStatus.Status
If Not ( Instr (1, Ucase( objTestExecStatus.Status ), Ucase ( "Passed" ) ) > 0 ) Then
strReportStatus = "Failed"
testsPassed = 0
Exit For
Else
testsPassed = 1
End If
Next
objTDCon.DisconnectProject
If (Err.Number > 0) Then
'MsgBox "Run Time Error. Unable to complete the test execution !! " &
Err.Description
WScript.Quit 1
ElseIf testsPassed >0 Then
'Msgbox "Tests Passed !!"
WScript.Quit 0
Else
'Msgbox "Tests Failed !!"
WScript.Quit 1
End If
这是我以前写的一个小 vbscript。它将从 ALM 执行特定测试。我已经发表评论以便于理解。
On Error Resume Next
Dim objExplorer
'' Getting ALM username
strUserName = InputBox("Please enter your ALM login name:", _
"ALM login name")
'' Getting ALM password
strPassword = InputBox("Please enter your ALM Password:", _
"ALM Password")
'' QTP/UFT script path
Dim Test_path
Test_path = "[QualityCenter] Subject\folder1\sub-folder\script(test) name"
Dim qtApp ''As QuickTest.Application ''Declare the Application object variable
Dim qtTest ''As QuickTest.Test ''Declare a Test object variable
Set qtApp = CreateObject("QuickTest.Application") ''Create the Application object
''Check if the application is not already Launched
If Not qtApp.Launched then
qtApp.Launch
Else
Wscript.Echo "UFT is already open." & vbCrLf & "Please close the UFT and run the script again."
WScript.Quit
End If
qtApp.Visible = False ''Make the QTP/UFT visible
'' Connecting to ALM
If Not qtApp.TDConnection.IsConnected Then
qtApp.TDConnection.Connect "ALM URL","Domain","Project", strUserName, strPassword,False
End If
If Err.Number <> 0 Then HandleError
'' Set QTP/UFT run options
qtApp.Options.Run.RunMode = "Fast"
qtApp.Options.Run.ViewResults = False
qtApp.Open Test_path, True ''Open the test in read-only mode
If Err.Number <> 0 Then HandleError
'' set run settings for the test
Set qtTest = qtApp.Test
qtTest.Run ''Run the test
qtTest.Close ''Close the test
qtApp.quit ''Close the QTP/UFT
Wscript.Echo "Test is completed." ''Comment this line if you don't want the messagebox
Set qtTest = Nothing ''Release the Test object
Set qtApp = Nothing ''Release the Application object
'*****************************************************************************************************************
' Error handler
'*****************************************************************************************************************
Sub HandleError()
If qtApp.Launched then
qtApp.Quit
End If
numerr = Err.number
abouterr = Err.description
If numerr <> 0 Then
Wscript.Echo "An Error has occurred! Error number " & numerr & " of the type '" & abouterr & "'. Please check the error and run the script again."
End If
WScript.Quit
End Sub
您可以使用任务计划程序来计划此脚本。
更新（基于评论）
要使测试集定期 运行，您可以将 Vbscript 与 ALM 的 OTA API 一起使用，并在预定时间使用 Windows 调度程序 运行。
set tdc = createobject("TDApiOle80.TDConnection")
tdc.InitConnectionEx "http://qcURL/qcbin/"
tdc.login "yourUserName","yourPassword"
tdc.Connect "yourDomain","yourProject"
Set objShell = CreateObject("WScript.Shell")
Set TSetFact = tdc.TestSetFactory
Set tsTreeMgr = tdc.TestSetTreeManager
Set tsFolder = tsTreeMgr.NodeByPath("Root\Formal Tests\YourTestDirectory")
Set tsList = tsFolder.FindTestSets("Your TestSet name. This is case sensitive!")
Set theTestSet = tsList.Item(1)
Set Scheduler = theTestSet.StartExecution("")
Scheduler.RunAllLocally = True
Scheduler.run
Set execStatus = Scheduler.ExecutionStatus
Do While RunFinished = False
execStatus.RefreshExecStatusInfo "all", True
RunFinished = execStatus.Finished
Set EventsList = execStatus.EventsList
For Each ExecEventInfoObj in EventsList
strNowEvent = ExecEventInfoObj.EventType
Next
For i= 1 to execstatus.count
Set TestExecStatusobj =execstatus.Item(i)
intTestid = TestExecStatusobj.TestInstance
Next
Loop