出现错误"ActiveX组件没办法创建对象"运行测试集时

这是我有时写的一个小型vbscript.它将执行ALM的特定测试.我提出了一些评论，以便于理解.

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.

更新(基于评论)

要使测试集定期运行，可以将Vbscript与ALM的OTA API结合使用，并使用Windows计划程序在计划的时间运行.

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

这篇好文章是转载于：学新通技术网