Search code examples
vbscripthp-uftalm

Getting error "ActiveX component can’t create object" when running testset


I'm trying to run UFT script from ALM using VBScript, but I'm getting an error on the line:

set objScheduler = objTestSet.StartExecution ("").

Error:ActiveX component can’t create object

Full script:

' 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

Solution

  • Here is a small vbscript that I wrote sometime back. It will execute specific test from ALM. I've put comments for easy understanding.

    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  
    

    You can use Task Scheduler to schedule this script.


    Update (Based on comment)

    To get testsets to run periodically you can use Vbscript with ALM’s OTA API and use Windows scheduler to run at scheduled time.

    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