Showing posts with label Schedule the testset in QC by VBS. Show all posts
Showing posts with label Schedule the testset in QC by VBS. Show all posts

Monday

QTP/QC - Schedule the testset in QC by VBS

'User must Admin at the machine where he want to run the testset
'This can run manual as well as Automated test suite
' It can be schedule at any partcular future time
' User need not to open the QC

Public Sub RunTestSet(otdc,tsFolderName,tSetName,HostName,runWhere)


Dim TSetFact, tsList
Dim theTestSet
Dim tsTreeMgr
Dim tsFolder
Dim Scheduler
Dim nPath
Dim execStatus
' Get the test set tree manager from the test set factory
'tdc is the global TDConnection object.
Set TSetFact = otdc.TestSetFactory


Set tsTreeMgr = otdc.TestSetTreeManager


' Get the test set folder passed as an argument to the example code


nPath = "Root\" & Trim(tsFolderName)


Set tsFolder = tsTreeMgr.NodeByPath(nPath)


If tsFolder Is Nothing Then


err.Raise vbObjectError + 1, "RunTestSet", "Could not find folder " & nPath


End If



' Search for the test set passed as an argument to the example code



Set tsList = tsFolder.FindTestSets(tSetName)



If tsList Is Nothing Then


err.Raise vbObjectError + 1, "RunTestSet", "Could not find test set in the " & nPath


End If



If tsList.Count > 1 Then


MsgBox "FindTestSets found more than one test set: refine search"


Exit Sub


ElseIf tsList.Count < 1 Then

MsgBox "FindTestSets: test set not found"


Exit Sub


End If


Set theTestSet = tsList.Item(1)


Debug.Print theTestSet.ID


'Start the scheduler on the local machine


Set Scheduler = theTestSet.StartExecution(HostName)



'msgbox "pass"


'Set up for the run depending on where the test instances


' are to execute.




Select Case runWhere


Case "RUN_LOCAL"


'Run all tests on the local machine


Scheduler.RunAllLocally = True


Case "RUN_REMOTE"



'Set Scheduler = theTestSet.StartExecution(HostName)


'Run tests on a specified remote machine


Scheduler.TdHostName = HostName


'Scheduler.TdHostName=runWhere


' RunAllLocally must not be set for


' remote invocation of tests.


' Do not do this:


' Scheduler.RunAllLocally = False


Case "RUN_PLANNED_HOST"


'Run on the hosts as planned in the test set


Dim TSTestFact, TestList


Dim tsFilter


Dim TSTst


'Get the test instances from the test set


Set TSTestFact = theTestSet.TSTestFactory


Set tsFilter = TSTestFact.Filter


tsFilter.Filter("TC_CYCLE_ID") = theTestSet.ID


Set TestList = TSTestFact.NewList(tsFilter.Text)


Scheduler.RunAllLocally = False


End Select



'Run the tests


Scheduler.run



Set execStatus = Scheduler.ExecutionStatus



While (RunFinished = False)


execStatus.RefreshExecStatusInfo "all", True


RunFinished = execStatus.Finished


Wend


End Sub




'================================




Const qcHostName = "GiveQChost:8080"


Const qcDomain = "GiveDomain name"


Const qcProject = "GiveProject" 'Please define here the name of the project


Const qcUser = "User ID" 'Please define here the username



Const qcPassword = "Give Password HGBGH%3&42" 'Please define here the password


Dim tdc


Dim qcServer


Dim objArgs


Dim strArg


Dim strTestSet


Dim bRunCode



'======GETTING ARGUMENTS==============


set objArgs = WScript.Arguments


If WScript.Arguments.Count<1>2 Then


WScript.Echo "Remote_Scheduler"


bRunCode = False


Else


For Each strArg in objArgs


WScript.Echo strArg&" is starting…"


strTestSet = strArg


bRunCode = True


Next


End If


'===========================================================




If bRunCode Then


qcServer = "http://" & qcHostName


qcServer = qcServer & "/qcbin"


Set tdc = CreateObject("tdapiole80.tdconnection")




If (tdc Is Nothing) Then


MsgBox "tdc object is empty"


End If


tdc.InitConnectionEx qcServer


tdc.Login qcUser, qcPassword


tdc.Connect qcDomain, qcProject




RunTestSet tdc, "GiveFolder Name of Test Set","GiveTestSet name ","Givemachinename", "RUN_REMOTE"


'Disconnect from the project


If tdc.Connected Then


tdc.Disconnect


End If


'Log off the server


If tdc.LoggedIn Then


tdc.Logout


End If


'Release the TDConnection object.


tdc.ReleaseConnection


'"Check status (For illustrative purposes.)


Set tdc = Nothing


End IF