Получение ошибки «Компонент ActiveX не может создать объект» при запуске testset

Question

Я пытаюсь запустить скрипт из UFT ALM с помощью VBScript, но я получаю сообщение об ошибке на линии:

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 

Answer 1

Вот небольшой 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 

Планировщик заданий можно использовать для планирования этого скрипта.

---

Update (Основано на комментарий)

Чтобы получить testsets для периодического запуска вы можете использовать VBScript с OTA API ALM и использовать 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