QC OTA - Test Lab

Here are some amazing functions that can be reused wrt QC OTA for Test Lab module:

- Create Test Set

- Add tests to Test Set

- Create the supplied directory structure in the test lab

- Create a test set underneath a given parent

- Return a test set if it exists

- Returns a testsetfolder for the given path

Public Function TestLabCreateTestSet(strFolderPath As String, strTestSetName As String, ByRef CreatedTestSet As TestSet)

    Dim tstSetFolder As TestSetFolder
    Dim testSetFolderF As TestSetTreeManager
    Dim TestSetF As TestSetFactory
    Dim testSet1 As TestSet
    Dim oTestSet As TestSet
   
   
    'Does the test set already exist? If so return it
    Set oTestSet = TestLabGetTestSet(strFolderPath, strTestSetName)
    If Not (oTestSet Is Nothing) Then
        'MsgBox "Test Set Already Exists: " & strFolderPath & "\" & strTestSetName
        Set CreatedTestSet = oTestSet
        Exit Function
    End If
   
   
    Set testSetFolderF = tdc.TestSetTreeManager
    Set tstSetFolder = TestLabGetFolderByPath(strFolderPath)
   
    Set TestSetF = tstSetFolder.TestSetFactory
    Set testSet1 = TestSetF.AddItem(Null)
    testSet1.Name = strTestSetName
    testSet1.Status = "Open"
    testSet1.Field("CY_USER_01") = "Reviewed"
    'testSet1.
    testSet1.Post
   
   
    If Err = 0 Then
        TestLabCreateTestSet = True
        Set CreatedTestSet = testSet1
    Else
        MsgBox Err.Description        TestLabCreateTestSet = False
    End If
End Function

----------------------------------------------------------
Public Function TestLabAddTestToTestSet(ByVal objTestSet As TestSet, ByVal objTest As Test, ByRef objTestInTestSetObj) As Boolean
    Dim testInstanceF As TSTestFactory
   
    On Error GoTo ErrTrap
    'Get or create a test instance from the factory of the new test set
    Set testInstanceF = objTestSet.TSTestFactory
    Set objTestInTestSetObj = testInstanceF.AddItem(objTest.ID)
   
    objTestInTestSetObj.Status = "No Run"
    objTestInTestSetObj.Post
   
    TestLabAddTestToTestSet = True
    Exit Function
   
ErrTrap:
    MsgBox Err.Description, vbCritical, "TestLabAddTestToTestSet"
    TestLabAddTestToTestSet = False
End Function
------------------------------------------------------------------------
Public Sub TestLabCreateDirectoryStructure(ByVal strPath As String)
   
    Dim arrPath
    Dim n As Integer
    Dim strCurrentPath
    Dim strLastParent
    Dim strLeft
   
    'If they have supplied "root\" in the start of the string, strip this out
    If Len(strPath) > 5 Then
        strLeft = Left(strPath, 5)
        If UCase(strLeft) = "ROOT\" Then
            strPath = Right(strPath, Len(strPath) - 5)
        End If
    End If
   
    arrPath = Split(strPath, "\")
   
    strCurrentPath = "Root"
    strLastParent = "Root"
   
    'Create the directory
    For n = 0 To UBound(arrPath)
        'Update the current path value
        strCurrentPath = strCurrentPath & "\" & arrPath(n)
                'If the folder does not exist, create it
        If Not TestLabDoesFolderExist(strCurrentPath) Then
            Call TestLabCreateTestSetFolder(strLastParent, arrPath(n))
        End If
        'Update last parent
        strLastParent = strLastParent & "\" & arrPath(n)
    Next n
End Sub
----------------------------------------------------------------------
Public Function TestLabCreateTestSetFolder(ByVal strParentPath As String, ByVal strFolderName As String)
   
    If strFolderName = "" Then
        TestLabCreateTestSetFolder = False
        Exit Function
    End If
   
    'Add test set folder.
    Dim TestSetF As TestSetTreeManager
    Dim objParent As TestSetFolder
    Dim folder As TestSetFolder
   
       
    Set TestSetF = tdc.TestSetTreeManager
    Set objParent = TestLabGetFolderByPath(strParentPath)
    Set folder = objParent.AddNode(strFolderName)
    folder.Post
   
    If Err = 0 Then
        TestLabCreateTestSetFolder = True
    Else
        MsgBox Err.Description
        TestLabCreateTestSetFolder = False
    End If
       
End Function
-----------------------------------------------------------------------

Public Function TestLabDoesFolderExist(ByVal strPath As String)
   
    On Error Resume Next
    Dim tstSetFolder As TestSetFolder
    Dim testSetFolderF As TestSetTreeManager
    Dim objCurrentFolder As TestSetFolder
    Dim lastFolder As TestSetFolder
    Dim n
    Dim arrPath
   
    Set testSetFolderF = tdc.TestSetTreeManager
    Set lastFolder = testSetFolderF.Root
   
    'For some reason, NodeByPath is not working, but we can check it by getting the children
    arrPath = Split(strPath, "\")
   
    If UBound(arrPath) > 0 Then
        For n = 1 To UBound(arrPath)
            Set objCurrentFolder = Nothing
            Set objCurrentFolder = lastFolder.FindChildNode(arrPath(n))
            Set lastFolder = objCurrentFolder
        Next n
    End If
   
    If (objCurrentFolder Is Nothing) Then
        TestLabDoesFolderExist = False
    Else
        TestLabDoesFolderExist = True
    End If
   
   
    On Error GoTo 0
End Function
-------------------------------------------------------------
Public Function TestLabGetFolderByPath(strPath As String) As TestSetFolder
    Dim objTestTreeManager As TestSetTreeManager
    Dim objCurrentFolder As TestSetFolder
    Dim arrPath
    Dim n
   
    'Get the tree manager
    Set objTestTreeManager = tdc.TestSetTreeManager
    'Get the root object - we will search the children of this
    Set objCurrentFolder = objTestTreeManager.Root
   
    'Split out the path
    arrPath = Split(strPath, "\")
   
    'We already have the root as an object so skip element 0
    If UBound(arrPath) > 0 Then
        'Loop through the path, getting each folder as a child
        For n = 1 To UBound(arrPath)
            Set objCurrentFolder = objCurrentFolder.FindChildNode(arrPath(n))
        Next n
    End If
   
    Set TestLabGetFolderByPath = objCurrentFolder
End Function
--------------------------------------------------------------------
Public Function TestLabGetTestSet(ByVal strFolderPath As String, ByVal strTestSetName As String) As TestSet
   
    Dim tsFilter As TDFilter
    Dim tsList As IList
    Dim oTestSetFolder As TestSetFolder
    Dim aTestSet As TestSet
    Dim TSetFact As TestSetFactory
    Dim arrFolderPath() As String
   
       
    'Get the folder
    Set oTestSetFolder = TestLabGetFolderByPath(strFolderPath)
    Set TSetFact = tdc.TestSetFactory
   
    'When looking for the test sets we can use the "CY_FOLDER_ID" property. This contains the name of the parent folder
    'So we just need to extract what the name of the parent folder is
    arrFolderPath = Split(strFolderPath, "\") 'break up the paths so the parent folder is in the upper bound
    'Create the filter:
    Set tsFilter = TSetFact.Filter
    'Get a list of the test sets - this will contain all of the child test cases
    Set tsList = oTestSetFolder.FindTestSets("", False, tsFilter.Text)
   
    If Not (tsList Is Nothing) Then
        For Each aTestSet In tsList
            'Does this test set name and path match what we are looking for?
            If (UCase(aTestSet.TestSetFolder.Path) = UCase(strFolderPath)) And (UCase(aTestSet.Name) = UCase(strTestSetName)) Then
                'Return value & cleanup
                Set TestLabGetTestSet = aTestSet
                Set tsList = Nothing
                Set tsFilter = Nothing
                Set TSetFact = Nothing
                Set oTestSetFolder = Nothing
                Exit Function
            End If
        Next aTestSet
    End If
    'no matches found, return nothing
    Set TestLabGetTestSet = Nothing
    Set tsList = Nothing
    Set tsFilter = Nothing
    Set TSetFact = Nothing
    Set oTestSetFolder = Nothing
End Function

Source: http://automationandtesting.blogspot.co.uk/2011/11/treeview-for-quality-center-test-plan.html