Hi All,
You might have come across scenarios where you are required to pass/fail many test cases in a test set. As ALM does not support bulk update, the easy way is to write a macro that does the job.Below is code for the same.
Sub ConnectToQualityCenter()
Application.StatusBar = "Initiating connection"
Dim qcURL As String
Dim qcID As String
Dim qcPWD As String
Dim qcDomain As String
Dim qcProject As String
Dim tdConnection As Object
Dim TestSetFact, tsTreeMgr, tSetFolder, TestSetsList, theTestSet
Dim TestSetIdentifier, TSTestFact, TestSetTestsList, testInstanceF, aFilter
Dim lst, tstInstance
On Error GoTo err
qcURL = "http://<XXXXX>.us.<XXXXX>.com/qcbin"
qcID = Sheet1.Cells(2, 1)
qcPWD = Sheet1.Cells(2, 2)
If IsEmpty(qcID) Or IsEmpty(qcPWD) Then
Application.StatusBar = "UID/PWD fields are mandatory"
GoTo err2
End If
qcDomain = "<XXXXX>"
qcProject = "<XXXXX>"
'Display a message in Status bar
Application.StatusBar = "Connecting to ALM..."
'Create a Connection object to connect to Quality Center
Set tdConnection = CreateObject("TDApiOle80.TDConnection")
'Initialise the Quality center connection
tdConnection.InitConnectionEx qcURL
'Authenticating with username and password
tdConnection.Login qcID, qcPWD
Application.StatusBar = "Login successfull"
'connecting to the domain and project
tdConnection.Connect qcDomain, qcProject
'On successfull login display message in Status bar
Application.StatusBar = "Connection Established to <XXXXX>/<XXXXX>"
'---------------------------------------Connection Established --------------------------------------------------------------------------
' Get the test set tree manager from the test set factory
'tdconnection is the global TDConnection object.
Set TSetFact = tdConnection.TestSetFactory
Set tsTreeMgr = tdConnection.testsettreemanager
' Get the test set folder passed as an argument to the example code
npath = Sheet1.Cells(2, 4)
testSetName = Split(npath, "\")(UBound(Split(npath, "\")))
npath = Replace(npath, testSetName, "")
Set tsFolder = tsTreeMgr.NodeByPath(npath)
'--------------------------------Check if the Path Exists or NOt ---------------------------------------------------------------------
If tsFolder Is Nothing Then
Application.StatusBar = "Invalid test set path"
End If
' Search for the test set passed as an argument to the example code
Set tsList = tsFolder.FindTestSets(testSetName)
'----------------------------------Check if the Test Set Exists --------------------------------------------------------------------
If tsList Is Nothing Then
Application.StatusBar = "Invalid test set name"
End If
'---------------------------------------------Check if the TestSetExists or is Duplicated ----------------------------------------------
If tsList.Count > 1 Then
Application.StatusBar = "Found more than one test set:-> refine search"
Exit Sub
ElseIf tsList.Count < 1 Then
Application.StatusBar = "Test set not found"
Exit Sub
End If
'-------------------------------------------Access the Test Cases inside the Test SEt -------------------------------------------------
allScriptsNames = ""
usedrowsCounter = Sheet1.UsedRange.Rows.Count
For rI = 2 To usedrowsCounter
If IsEmpty(Sheet1.Cells(rI, 5)) Or IsEmpty(Sheet1.Cells(rI, 6)) Or InStr(1, allScriptsNames, Sheet1.Cells(rI, 5)) > 1 Then
Else
allScriptsNames = allScriptsNames & "##" & Sheet1.Cells(rI, 5) & "##" & Sheet1.Cells(rI, 6)
End If
Next
Set theTestSet = tsList.Item(1)
For Each testsetfound In tsList
Set tsFolder = testsetfound.TestSetFolder
Set tsTestFactory = testsetfound.tsTestFactory
Set tsTestList = tsTestFactory.NewList("")
For Each tsTest In tsTestList
Application.StatusBar = tsTest.Name & tsTest.TestId
testrunname = Sheet1.Cells(2, 3)
If InStr(1, allScriptsNames, tsTest.Name + "##") > 1 Then
'MsgBox Split(Split(allScriptsNames, tsTest.Name + "##")(1), "##")(0)
'--------------------------------------------Accesss the Run Factory --------------------------------------------------------------------
Set RunFactory = tsTest.RunFactory
Set obj_theRun = RunFactory.AddItem(CStr(testrunname))
obj_theRun.Status = Split(Split(allScriptsNames, tsTest.Name + "##")(1), "##")(0)
obj_theRun.Post
End If
Next tsTest
Next testsetfound
err:
tdConnection.Disconnect
tdConnection.Logout
tdConnection.ReleaseConnection
Application.StatusBar = "Logged Out"
err2:
If (err.Number <> 0) Then
'Display the error message in Status bar
Application.StatusBar = err.Description
End If
End Sub
Function TimeStamp()
Dim CurrTime
CurrTime = Now()
TimeStamp = CStr(Year(CurrTime)) & "-" _
& LZ(Month(CurrTime)) & "-" _
& LZ(Day(CurrTime)) & " " _
& LZ(Hour(CurrTime)) & ":" _
& LZ(Minute(CurrTime)) & ":" _
& LZ(Second(CurrTime))
End Function
You might have come across scenarios where you are required to pass/fail many test cases in a test set. As ALM does not support bulk update, the easy way is to write a macro that does the job.Below is code for the same.
Sub ConnectToQualityCenter()
Application.StatusBar = "Initiating connection"
Dim qcURL As String
Dim qcID As String
Dim qcPWD As String
Dim qcDomain As String
Dim qcProject As String
Dim tdConnection As Object
Dim TestSetFact, tsTreeMgr, tSetFolder, TestSetsList, theTestSet
Dim TestSetIdentifier, TSTestFact, TestSetTestsList, testInstanceF, aFilter
Dim lst, tstInstance
On Error GoTo err
qcURL = "http://<XXXXX>.us.<XXXXX>.com/qcbin"
qcID = Sheet1.Cells(2, 1)
qcPWD = Sheet1.Cells(2, 2)
If IsEmpty(qcID) Or IsEmpty(qcPWD) Then
Application.StatusBar = "UID/PWD fields are mandatory"
GoTo err2
End If
qcDomain = "<XXXXX>"
qcProject = "<XXXXX>"
'Display a message in Status bar
Application.StatusBar = "Connecting to ALM..."
'Create a Connection object to connect to Quality Center
Set tdConnection = CreateObject("TDApiOle80.TDConnection")
'Initialise the Quality center connection
tdConnection.InitConnectionEx qcURL
'Authenticating with username and password
tdConnection.Login qcID, qcPWD
Application.StatusBar = "Login successfull"
'connecting to the domain and project
tdConnection.Connect qcDomain, qcProject
'On successfull login display message in Status bar
Application.StatusBar = "Connection Established to <XXXXX>/<XXXXX>"
'---------------------------------------Connection Established --------------------------------------------------------------------------
' Get the test set tree manager from the test set factory
'tdconnection is the global TDConnection object.
Set TSetFact = tdConnection.TestSetFactory
Set tsTreeMgr = tdConnection.testsettreemanager
' Get the test set folder passed as an argument to the example code
npath = Sheet1.Cells(2, 4)
testSetName = Split(npath, "\")(UBound(Split(npath, "\")))
npath = Replace(npath, testSetName, "")
Set tsFolder = tsTreeMgr.NodeByPath(npath)
'--------------------------------Check if the Path Exists or NOt ---------------------------------------------------------------------
If tsFolder Is Nothing Then
Application.StatusBar = "Invalid test set path"
End If
' Search for the test set passed as an argument to the example code
Set tsList = tsFolder.FindTestSets(testSetName)
'----------------------------------Check if the Test Set Exists --------------------------------------------------------------------
If tsList Is Nothing Then
Application.StatusBar = "Invalid test set name"
End If
'---------------------------------------------Check if the TestSetExists or is Duplicated ----------------------------------------------
If tsList.Count > 1 Then
Application.StatusBar = "Found more than one test set:-> refine search"
Exit Sub
ElseIf tsList.Count < 1 Then
Application.StatusBar = "Test set not found"
Exit Sub
End If
'-------------------------------------------Access the Test Cases inside the Test SEt -------------------------------------------------
allScriptsNames = ""
usedrowsCounter = Sheet1.UsedRange.Rows.Count
For rI = 2 To usedrowsCounter
If IsEmpty(Sheet1.Cells(rI, 5)) Or IsEmpty(Sheet1.Cells(rI, 6)) Or InStr(1, allScriptsNames, Sheet1.Cells(rI, 5)) > 1 Then
Else
allScriptsNames = allScriptsNames & "##" & Sheet1.Cells(rI, 5) & "##" & Sheet1.Cells(rI, 6)
End If
Next
Set theTestSet = tsList.Item(1)
For Each testsetfound In tsList
Set tsFolder = testsetfound.TestSetFolder
Set tsTestFactory = testsetfound.tsTestFactory
Set tsTestList = tsTestFactory.NewList("")
For Each tsTest In tsTestList
Application.StatusBar = tsTest.Name & tsTest.TestId
testrunname = Sheet1.Cells(2, 3)
If InStr(1, allScriptsNames, tsTest.Name + "##") > 1 Then
'MsgBox Split(Split(allScriptsNames, tsTest.Name + "##")(1), "##")(0)
'--------------------------------------------Accesss the Run Factory --------------------------------------------------------------------
Set RunFactory = tsTest.RunFactory
Set obj_theRun = RunFactory.AddItem(CStr(testrunname))
obj_theRun.Status = Split(Split(allScriptsNames, tsTest.Name + "##")(1), "##")(0)
obj_theRun.Post
End If
Next tsTest
Next testsetfound
err:
tdConnection.Disconnect
tdConnection.Logout
tdConnection.ReleaseConnection
Application.StatusBar = "Logged Out"
err2:
If (err.Number <> 0) Then
'Display the error message in Status bar
Application.StatusBar = err.Description
End If
End Sub
Function TimeStamp()
Dim CurrTime
CurrTime = Now()
TimeStamp = CStr(Year(CurrTime)) & "-" _
& LZ(Month(CurrTime)) & "-" _
& LZ(Day(CurrTime)) & " " _
& LZ(Hour(CurrTime)) & ":" _
& LZ(Minute(CurrTime)) & ":" _
& LZ(Second(CurrTime))
End Function