Dear LEM Readers,
In previous article, we learnt How to connect to HP QC using Excel Macro. In this article we are going to learn How to create folder structure in HP QC Test Lab. As you must be knowing – To show the test execution in Test Lab you should follow below steps:

  • Step 1. Create folder structure in Test Lab (most of the time same as in Test Plan but not necessary)
  • Step 2. Now Pull the corresponding test cases from Test Plan to Test Lab. Refer Pic 1
HP QC- Mapping Test Cases in Test Lab

Pic 1-HP QC - Mapping Test Cases in Test Lab

In this article you are going to learn how to create folder structure in Test lab and Mapping or pulling test cases from Test Plan to Test Lab.

Copy and paste the below code in any of the module in your VBA code and follow the comments which are written within the code to understand.

Below code will make exactly same folder structure as Test Plan in Test lab and It will also map corresponding test cases in the test lab from Test Plan.

Sub Pull_Test_Cases_in_Lab()
On Error Resume Next

Dim tdConnection
Dim qcUser, qcPassword
Dim qcDomain, qcProject
Dim qcURL

Dim myFolder As String
Dim treeMgr As Variant
Dim myTestFact As Variant
Dim myTestFilter As Variant
Dim myTestList As Variant

'Provide all details
    qcUser = ""
    qcDomain = ""
    qcProject = ""
    qcURL = ""
'Create QC connection object
Set tdConnection = CreateObject("TDApiOle80.TDConnection")
'Initialise the Quality center connection
   tdConnection.InitConnectionEx qcURL
   'Authenticate username and password
tdConnection.Login qcUser, qcPassword
'login to the domain and project
   tdConnection.Connect qcDomain, qcProject
    Set treeMgr = tdConnection.treemanager
    Set myTestFact = tdConnection.TestFactory
    Set myTestFilter = myTestFact.Filter
    ' Apply filter on the last known node
    ' Suppose you want to map all the test cases
    ' of your Project Folder XYZ then provide
    ' the complete path till XYZ
    ' For example: "^\Subject\XYZ\^"
myFolder = "Subject\Test Project 1"

    'Get the complete test list in the main folder
    Set myTestList = myTestFact.newList(myTestFilter.Text)
    myTestFilter.Filter("TS_SUBJECT") = "^\" & myFolder & "^"
    'Exit if no test cases found in the above folder
    If myTestList.Count = 0 Then
        MsgBox "Zero Test Case Found "
        Exit Sub
    End If
    ' get all the tets cases available in the
    ' above main folder
    tcCount = myTestList.Count
    ' traverse through each test cases
    ' in testList array you got
    For Each tc In myTestList
        ' Get the Subject Folder Node
        Set myTCNode = tc.Field("TS_Subject ")
        ' Get Complete path of test case without Test Name
        myPath = myTCNode.path
        'Create Folder stucture and pull the
        ' test cases in to test set in test lab
        ' from test plan
        map_TestCase myPath, tc
    Set myTestList = Nothing
    Set myTestFilter = Nothing
    Set myTestFact = Nothing
End Sub

Sub map_TestCase(myPath, myTC)

         Dim tcMgr As Variant
         Dim myRoot As Variant
         Dim newTSTest As Variant
         Dim TSFact As Variant
         Dim TSFilter As Variant

         On Error Resume Next
         Set tcMgr = tdConnection.TestSetTreeManager

         ' Split path for loop
         subjectArray = Split(myPath, "\")
         ' in Test Plan folder structure starts with Subject
         ' while in Test Lab it is "Root ". So we need to change
         ' the path
         NewPath = "Root "
         OldPath = ""

         For iFolder = 1 To UBound(subjectArray)
             'Assign old to new path
             OldPath = NewPath

             'get current folder
             CurrentSubName = subjectArray(iFolder)
             'build new path
             NewPath = Trim(NewPath) & "\" & CurrentSubName
             'search Folder
             Set newNode = tcMgr.NodeByPath(NewPath)

             'create folder if it does not exist
             If newNode Is Nothing Then
                Set tcMgr = Nothing
                Set tcMgr = tdConnection.TestSetTreeManager

                If iFolder = 1 Then
                   Set myRoot = tcMgr.Root
                    Set myRoot = tcMgr.NodeByPath(OldPath)
                End If ' iFolder'

                Set newNode = myRoot.AddNode(CurrentSubName)
             End If 'new Node

             ' if the current folder is the last folder of the array
             ' then create the testset

             If iFolder = UBound(subjectArray) Then

                Set TSFact = newNode.TestSetFactory
                Set TSFilter = TSFact.Filter
                TSFilter.Filter("CY_FOLDER_ID ") = newNode.Nodeid
                TSFilter.Filter("CY_CYCLE ") = CurrentSubName
                Set TSList = TSFact.newList(TSFilter.Text)

                'If no testset found in test plan then TestSet folder will
                'not be created. If you want to do so uncomment the below
                'if else conditions
                'If TSList.Count = 0 Then
                   'Set TestSet1 = TSFact.AddItem(Null)
                   'TestSet1.Name = CurrentSubName
                   'TestSet1.Status = "Open "
                    Set TestSet1 = TSList.Item(1)
                'End If

                Set TSTestFact = TestSet1.TSTestFactory
                Set TSTestList = TSTestFact.newList("")
                'Initilize the variable to check if any Test case found
                foundTCs = 0

                If TSTestList.Count > 0 Then

                   For Each myTSTest In TSTestList

                       If myTSTest.TestID = Trim(CurrentTest.ID & "") Then
                          foundTCs = 1
                       End If


                End If

                 If foundTCs = 0 Then
                    Set newTSTest = TSTestF.AddItem(CurrentTest.ID)
                 End If

             End If

             Set newTSTest = Nothing
             Set myTSTest = Nothing
             Set TSFilter = Nothing
             Set TSTestF = Nothing
             Set TSTestList = Nothing
             Set TSFilter = Nothing
             Set TSFact = Nothing
             Set newNode = Nothing

         On Error GoTo 0
End Sub


Join over 10, 000+ Excel VBA Enthusiasts & get this FREE e-Book Now!