Utility to create tests in test plan of Quality Center

Problem: Create tests in the test plan by copying a base test in QC to a destination folder in QC with the test names from the file system's existing folders/files.

Solution: Created a macro using OTA to do the same:

Code:

Private Sub CommandButton1_Click()
   
    If LoadQCConnectForm Then
    End If
   
    Dim FSO As Object
    Dim Folder As Object
    Dim FolderName As String
    Dim SubFolder As Object
    Dim strTestCase As String
    Dim TestCaseName As String
   
    'Parent Directory - Change this to whichever directory you want to use
    FolderName = GetVariable("Fitnesse Path")
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Folder = FSO.GetFolder(FolderName)
          
    For Each Folder In Folder.SubFolders
            TestCaseName = GetVariable("QC Fitnesse Path") & "." & Folder.Name
            Call TestPlanCopyPasteTest(GetVariable("QC Source"), GetVariable("QC Dest"), "BaseTest", TestCaseName)
            Call RebootQCCon
    Next Folder
   
    Set FSO = Nothing
    MsgBox "All Fitnesse tests created"
   
End Sub
###########################################################
'Module1
Option Explicit
Public Const SHT_VARIABLES = "variables"

'Function Name:     GetVariable
'Function Purpose:  Returns the value of a variable
'Input Parameters:  strVariableName - Name of the variable to lookup
'Output Parameters: None
'Return Value:      String containing the variable value
Function GetVariable(ByVal strVariableName As String) As String
    Dim n
   
    n = 2
   
    While Sheets(SHT_VARIABLES).Cells(n, 1) <> ""
        If Sheets(SHT_VARIABLES).Cells(n, 1) = strVariableName Then
            GetVariable = Sheets(SHT_VARIABLES).Cells(n, 2)
            Exit Function
        End If
        n = n + 1
    Wend
   
    MsgBox "Variable not found: " & strVariableName, vbCritical + vbOKOnly
End Function
'Function Name:     SetVariable
'Function Purpose:  sets the value of a variable
'Input Parameters:  strVariableName - Name of the variable to set
'                   strValue - value of the variable to set
Sub SetVariable(ByVal strVariableName As String, ByVal strValue As String)
    Dim n
   
    n = 2
   
    While Sheets(SHT_VARIABLES).Cells(n, 1) <> ""
        If Sheets(SHT_VARIABLES).Cells(n, 1) = strVariableName Then
            Sheets(SHT_VARIABLES).Cells(n, 2) = strValue
            Exit Sub
        End If
        n = n + 1
    Wend
   
    MsgBox "Variable not found: " & strVariableName, vbCritical + vbOKOnly
End Sub
###########################################################
'Module2

Option Explicit


Global tdc As TDConnection 'Global object storing the QC connection
Public QCConnected As Boolean


Public sHost    'stores the host name for the QC connection reboot
Public sDomain  'stores the domain for the QC connection reboot
Public sProject 'stores the project for the QC connection reboot
Public sUser    'stores the username for the QC connection reboot
Public sPassword 'stores the password for the QC connection reboot
Public sPort   'stores the port for the QC connection reboot


'Function Name:     RebootQCCon
'Function Purpose:  Resets the connection to Quality Center - required for some of our actions which are breaking due to QC bug that doesn't let us set filters
'Input Parameters:  None
'Output Parameters:
'Return Value:      Boolean - True or False
Public Sub RebootQCCon()
    Call ConnectToQC(sHost, sDomain, sProject, sUser, sPassword, sPort)
End Sub


'Function Name:     ConnectToQC
'Function Purpose:  Makes the connection to Quality Center - taken from the OTA help reference
'Input Parameters:  qcHostName$ - name of the qc server e.g "server085"
'                   qcDomain$ - Domain to connect to
'                   qcProject$ - QC project to connect to
'                   qcUser$ - QC username
'                   qcPassword$ - QC password
'                   qcPort - port to connect to
'Output Parameters:
Public Function ConnectToQC(qcHostName, qcDomain, qcProject, _
    qcUser, qcPassword, Optional qcPort) As Boolean
    
    QCConnected = False
    On Error Resume Next
    tdc.DisconnectProject
    tdc.Disconnect
    tdc.Logout
    On Error GoTo 0
    
    'Assign these to the private variables - useful if we need to reboot the QC connection
    sHost = qcHostName
    sDomain = qcDomain
    sProject = qcProject
    sUser = qcUser
    sPassword = qcPassword
    sPort = qcPort
    
    '------------------------------------------------------------------------
    ' This routine makes the connection to the gobal TDConnection object
    ' (declared at the project level as Global tdc as TDConnection)
    ' and connects the user to the specified project.
    '-----------------------------------------------------------------------
    Dim qcServer As String
    Dim errmsg As String
    Const fName = "makeConnection" 'For error message


    On Error GoTo makeConnectionErr
    errmsg = ""


    ' Construct server argument using format:
    ' "http://server:port/qcbin"
    qcServer = "http://" & qcHostName


    If Not (IsMissing(qcPort)) Then
        If Len(qcPort) > 0 Then qcServer = qcServer & ":" & qcPort
    End If


    qcServer = qcServer & "/qcbin"


    ' Check status (for demonstration purposes only).
    ' MsgBox tdc.LoggedIn 'Error: OTA Server is not connected
    ' MsgBox tdc.Connected 'False
    ' MsgBox tdc.ServerName 'Blank string
    ' Create the connection.
    errmsg = "Failed to create TDConnection"
    If (tdc Is Nothing) Then Set tdc = New TDConnection
    If (tdc Is Nothing) Then GoTo makeConnectionErr
    errmsg = ""
    tdc.InitConnectionEx qcServer
    ' Check status.
    ' MsgBox tdc.LoggedIn 'False
    ' MsgBox tdc.Connected 'True
    ' MsgBox tdc.ServerName 'http:///qcbin/wcomsrv.dll


    
    tdc.Login qcUser, qcPassword
    ' Check status.
    ' MsgBox tdc.LoggedIn 'True
    ' MsgBox tdc.ProjectName 'Empty String
    ' MsgBox tdc.ProjectConnected 'False
    ' Connect to the project and user.
    tdc.Connect qcDomain, qcProject
    ConnectToQC = True
    QCConnected = True
    Exit Function


makeConnectionErr:
    ConnectToQC = False
    MsgBox Err & " " & fName & " " & Err.Description & vbCrLf & errmsg


End Function


'Function Name:     LoadQCConnectForm
'Function Purpose:  Loads the Quality Center Connection Form
'Input Parameters:  None
'Output Parameters:
'Return Value:      True if the user connected to QC
Public Function LoadQCConnectForm() As Boolean


    If Not ConnectToQC(GetVariable("QC Server"), GetVariable("QC Domain"), GetVariable("QC Project"), GetVariable("QC Username"), GetVariable("QC Password"), "") Then
        Load QCConnect
        QCConnect.Show
        LoadQCConnectForm = QCConnected
    Else
        LoadQCConnectForm = True
    End If
End Function
###########################################################
'Module3

'Function Name:     TestPlanCopyPasteTest

'Function Purpose:  Copies a test in the test plan (taken from the OTA documentation). Tweaked to actually work!!

'Input Parameters:  strSourceFolderPath - source folder path to copy

'                   strDestFolderPath - destination to copy to

'                   strSourceTestName - name of test to copy

'                   strNewTestName - new name to give test

Function TestPlanCopyPasteTest(strSourceFolderPath, strDestFolderPath, strSourceTestName, strNewTestName) As Boolean

    'Copy a test, including design steps and parameters.

    ' For example:

    ' CopyPasteTest "Subject\TestFolder1", "Subject\TestFolder2", "Test1"

    ' Copies Test1 to TestFolder2

     Dim sourceFolder As SubjectNode

     Dim destFolder As SubjectNode

     Dim treeMng As TreeManager

     Dim iscp As ISupportCopyPaste

     Dim clipboard As String

     Dim oSourceTest As Test

     Dim oNewTest As Test

     

     'Check that the source file exists

     If Not TestPlanDoesTestExist(strSourceTestName, strSourceFolderPath, False, "") Then

        TestPlanCopyPasteTest = False

        MsgBox "Source test does not exist: " & strSourceFolderPath & "\" & strSourceTestName, vbExclamation + vbOKOnly, "TestPlanCopyPasteTest"

        Exit Function

     End If

    

    'Check that the destination test does not exist

     If TestPlanDoesTestExist(strNewTestName, strDestFolderPath, False, "") Then

        TestPlanCopyPasteTest = False

        MsgBox "Destination test already exists: " & strDestFolderPath & "\" & strNewTestName, vbExclamation + vbOKOnly, "TestPlanCopyPasteTest"

        Exit Function

     End If

     

     'On Error GoTo errCondition

    

     Set sourceFolder = TestPlanGetSubjectNode(strSourceFolderPath)

     Set testF = sourceFolder.TestFactory

     ' Find the test ID.

     Set oSourceTest = TestPlanFindTest(strSourceTestName, strSourceFolderPath, False, "", True)

     ' Copy the source test.

     Set iscp = testF

     clipboard = iscp.CopyToClipBoard(oSourceTest.ID, 0, "")

     ' Paste the test in the destination folder.

     Set destFolder = TestPlanGetSubjectNode(strDestFolderPath)

     Set testF = destFolder.TestFactory

     Set iscp = testF

     iscp.PasteFromClipBoard clipboard, destFolder.NodeID

     

     'Now it's pasted, rename it

     'Reboot the QC connection as we get some failures around this point

     Call RebootQCCon

     Set oNewTest = TestPlanFindTest(strSourceTestName, strDestFolderPath, False, "")

     oNewTest.Name = strNewTestName

     oNewTest.Post

     ' Clean up.

     Set iscp = Nothing

     Set treeMng = Nothing

     Set sourceFolder = Nothing

     Set destFolder = Nothing

     Set oNewTest = Nothing

     Set oSourceTest = Nothing

     

     TestPlanCopyPasteTest = True

     Exit Function

     

errCondition:

     MsgBox "Error: " & Err.Description, vbExclamation + vbOKOnly, "TestPlanCopyPasteTest"

     TestPlanCopyPasteTest = False

End Function

'Function Name:     TestPlanCreateFolderStructure

'Function Purpose:  Creates a Folder Structure in the Test Plan

'Input Parameters:  strFullPath - Full Path of the Structure to Create e.g "Subject\A\B\C"

Sub TestPlanCreateFolderStructure(strFullPath)

    Dim arrFolders() As String

    Dim n As Integer

    Dim strParentPath As String

    Dim strThisPath As String

    Dim oParentFolder As SubjectNode

    

    'First of all, does the folder structure already exist?

    If TestPlanDoesPathExist(strFullPath) Then Exit Sub

    

    'Now split the path up into its individual folders

    arrFolders = Split(strFullPath, "\")

    

    'does the first element contain subject? if not, exit

    If UCase(arrFolders(0)) <> "SUBJECT" Then

        MsgBox "Error: The first element in the folder path must be 'Subject'", vbExclamation + vbOKOnly, "TestPlanCreateFolderStructure"

        Exit Sub

    End If

    

    'iterate the array

    For n = 0 To UBound(arrFolders)

        'Create the folder if it doesn't exist

        If strParentPath <> "" Then

            strThisPath = strParentPath & "\" & arrFolders(n)

            Debug.Print "strThisPath=" & strThisPath

            'Does this path exist? If not we need to create it

            If (TestPlanDoesPathExist(strThisPath) = False) And (arrFolders(n) <> "") Then

                'Create it

                'Get the parent folder

                Set oParentFolder = TestPlanGetSubjectNode(strParentPath)

                'Create this folder underneath it

                oParentFolder.AddNode (arrFolders(n))

            End If

        End If

        

        'before we move on, set the parent path

        If strParentPath = "" Then

            strParentPath = "Subject"

        Else

            strParentPath = strThisPath

        End If

    Next n

    

    'Release all objects

    Set oParentFolder = Nothing

End Sub

'Function Name:     TestPlanDoesPathExist

'Function Purpose:  Returns True if the path exists

'Input Parameters:  strPath - Path in the test plan to search for

'Output Parameters: None

'Return Value:      True or False

Function TestPlanDoesPathExist(ByVal strPath As String) As Boolean

    Dim TreeMgr As TreeManager

    Dim SubjRoot As SubjectNode

    Dim SubjectNodeList As List

    Dim oSubjectNode As SubjectNode

    

    

    Set TreeMgr = tdc.TreeManager

    Set SubjRoot = TreeMgr.TreeRoot("Subject")

    

    If UCase(strPath) = "SUBJECT" Then

        TestPlanDoesPathExist = True

        Exit Function

    End If

    

    Set SubjectNodeList = SubjRoot.FindChildren("", False, "")

    

    For Each oSubjectNode In SubjectNodeList

        If UCase(oSubjectNode.Path) = UCase(strPath) Then

            TestPlanDoesPathExist = True

            Set TreeMgr = Nothing

            Set SubjRoot = Nothing

            Set SubjectNodeList = Nothing

            Set oSubjectNode = Nothing

            Exit Function

        End If

    Next

    

    TestPlanDoesPathExist = False

    Set TreeMgr = Nothing

    Set SubjRoot = Nothing

    Set SubjectNodeList = Nothing

    Set oSubjectNode = Nothing

End Function

'Function Name:     TestPlanDoesTestExist

'Function Purpose:  Determines if a test exists in a certain location

'Input Parameters:  strTestName - Name of the test to find e.g. "Test 001"

'                   strFolderToSearchPath - Name of the folder to search e.g. "Subject\Regression\Project A"

'                   SearchChildFolders - Set to true to look in child folders

'                   strTestType - The type of test to find, e.g. "QUICKTEST_TEST"

'Output Parameters: None

Function TestPlanDoesTestExist(ByVal strTestName As String, ByVal strFolderToSearchPath As String, ByVal SearchChildFolders As Boolean, Optional ByVal strTestType As String) As Boolean

    Dim oTempTest As Test

    

    Set oTempTest = TestPlanFindTest(strTestName, strFolderToSearchPath, SearchChildFolders, strTestType, True)

    

    If (oTempTest Is Nothing) Then

        TestPlanDoesTestExist = False

    Else

        TestPlanDoesTestExist = True

    End If

    

    Set oTempTest = Nothing

End Function

'Function Name:     TestPlanFindTest

'Function Purpose:  Searches for a test within a folder and returns it as a Test Object

'Input Parameters:  strTestName - Name of the test to find e.g. "Test 001"

'                   strFolderToSearchPath - Name of the folder to search e.g. "Subject\Regression\Project A"

'                   SearchChildFolders - Set to true to look in child folders

'                   strTestType - The type of test to find, e.g. "QUICKTEST_TEST"

Function TestPlanFindTest(ByVal strTestName As String, ByVal strFolderToSearchPath As String, ByVal SearchChildFolders As Boolean, Optional ByVal strTestType As String, Optional blnSilentMode As Boolean) As Test

    

    Dim oParentNode As SubjectNode

    Dim SubjectNodeList As List

    Dim oSubjectNode As SubjectNode

    Dim intMatchCount As Integer: intMatchCount = 0

    Dim TestFact As TestFactory

    Dim oReturnValue As Test

    Dim TestFilter As TDFilter

    Dim TestList As List

    Dim oTest As Test

    Dim blnTypedMatched As Boolean: blnTypedMatched = True

    

    Set oParentNode = TestPlanGetSubjectNode(strFolderToSearchPath)

    Set TestFact = tdc.TestFactory

    

    'If there was an error getting the parent node then exit

    If (oParentNode Is Nothing) Then

        Set TestPlanFindTest = Nothing

        Exit Function

    End If

    'See if the parent folder has any tests that match the name we are looking for

    Set TestFilter = TestFact.Filter

    TestFilter.Filter("TS_SUBJECT") = Chr(34) & oParentNode.Path & Chr(34)

    Set TestList = TestFact.NewList(TestFilter.Text)

    For Each oTest In TestList

        'Debug.Print "Test Name='" & oTest.Name & "' Test Type=" & oTest.Type

        If (UCase(oTest.Name) = UCase(strTestName)) Then

            'See if we should match the type - by default it is set to matched (true)

            If (strTestType) <> "" Then

                If (oTest.Type = strTestType) Then

                    blnTypedMatched = True

                Else

                    blnTypedMatched = False

                End If

            End If

            

            If blnTypedMatched Then

                intMatchCount = intMatchCount + 1

                Set oReturnValue = oTest

            End If

        End If

    Next

    

    'Now check to see if we wanted to search child folders? If so search them

    If SearchChildFolders Then

        'Get all the child folders of the parent folder

        Set SubjectNodeList = oParentNode.FindChildren("", False, "")

        If Not (SubjectNodeList Is Nothing) Then

            For Each oSubjectNode In SubjectNodeList

                'Debug.Print oSubjectNode.Path

                Set TestFilter = TestFact.Filter

                TestFilter.Filter("TS_SUBJECT") = Chr(34) & oSubjectNode.Path & Chr(34)

                Set TestList = TestFact.NewList(TestFilter.Text)

                For Each oTest In TestList

                    'Debug.Print "Test Name='" & oTest.Name & "' Test Type=" & oTest.Type

                    If (UCase(oTest.Name) = UCase(strTestName)) Then

                        'See if we should match the type - by default it is set to matched (true)

                        If (strTestType) <> "" Then

                            If (oTest.Type = strTestType) Then

                                blnTypedMatched = True

                            Else

                                blnTypedMatched = False

                            End If

                        End If

                        

                        If blnTypedMatched Then

                            intMatchCount = intMatchCount + 1

                            Set oReturnValue = oTest

                        End If

                    End If

                Next

            Next

        End If

    End If

    

    

    'Clean Up

    Set oParentNode = Nothing

    Set SubjectNodeList = Nothing

    Set oSubjectNode = Nothing

    Set TestFact = Nothing

    Set TestFilter = Nothing

    Set TestList = Nothing

    Set oTest = Nothing

    

    

    'Now return a value

    Select Case intMatchCount

        Case 0

            If Not blnSilentMode Then

                MsgBox "Error: The Test could not be found with the parameters: " & Chr(10) & _

                    "Test Name:" & strTestName & Chr(10) & _

                    "Parent Folder Path:" & strFolderToSearchPath & Chr(10) & _

                    "Test Type:" & strTestType & Chr(10) & _

                    "Search child folders?:" & SearchChildFolders, vbExclamation + vbOKOnly, "TestPlanFindTest"

            End If

            Set TestPlanFindTest = Nothing

        Case 1

            Set TestPlanFindTest = oReturnValue

        Case Else

            If Not blnSilentMode Then

                MsgBox "Error: A total of " & intMatchCount & " tests were found with the following criteria: " & Chr(10) & _

                    "Test Name:" & strTestName & Chr(10) & _

                    "Parent Folder Path:" & strFolderToSearchPath & Chr(10) & _

                    "Test Type:" & strTestType & Chr(10) & _

                    "Search child folders?:" & SearchChildFolders, vbExclamation + vbOKOnly, "TestPlanFindTest"

            End If

            Set TestPlanFindTest = Nothing

    End Select

End Function

'Function Name:     TestPlanGetSubjectNode

'Function Purpose:  Returns a SubjectNode object for a given path in the Test Plan

'Input Parameters:  strPath - Path in the test plan to return as a SubjectNode

Function TestPlanGetSubjectNode(ByVal strPath As String) As SubjectNode

    Dim TreeMgr As TreeManager

    Dim SubjRoot As SubjectNode

    Dim SubjectNodeList As List

    Dim oSubjectNode As SubjectNode

    

    

    Set TreeMgr = tdc.TreeManager

    Set SubjRoot = TreeMgr.TreeRoot("Subject")

    

    'Trim any trailing \

    If Right(strPath, 1) = "\" Then strPath = Left(strPath, Len(strPath) - 1)

    

    If UCase(strPath) = "SUBJECT" Then

        Set TestPlanGetSubjectNode = SubjRoot

        Set TreeMgr = Nothing

        Set SubjRoot = Nothing

        Exit Function

    End If

    

    

    Set SubjectNodeList = SubjRoot.FindChildren("", False, "")

    

    For Each oSubjectNode In SubjectNodeList

        If UCase(oSubjectNode.Path) = UCase(strPath) Then

            Set TestPlanGetSubjectNode = oSubjectNode

            Exit Function

        End If

    Next

    

    MsgBox "Test Plan path not found: " & strPath, vbExclamation + vbOKOnly, "TestPlanGetSubjectNode Error"

    Set TestPlanGetSubjectNode = Nothing

    Set TreeMgr = Nothing

    Set SubjRoot = Nothing

    Set SubjectNodeList = Nothing

    Set oSubjectNode = Nothing

End Function

###########################################################
'Module4

Option Explicit

Public Type ScannedTreeItems

    strKey As String

    strParentKey As String

    strValue As String

    strFullQCPath As String

End Type

Public Enum QCPlanExplorerSelection

    SelectAny = 0

    SelectFolder = 1

    SelectAnyTest = 2

    SelectQTPTest = 3

End Enum

Public QCTestPlanItems() As ScannedTreeItems

Public QCTestPlanItemsInitialised As Boolean

Private gintKey As Integer

Public gItemSelectedPath As String 'stores the path of the item selected from the explorer userform

'Function Name:     ResetQCTestPlanItems

'Function Purpose:  Resets the data structures keeping track of the scanned test plan folders

'Input Parameters:  None

'Modification Date:

Public Sub ResetQCTestPlanItems()

    ReDim QCTestPlanItems(0)

    QCTestPlanItemsInitialised = False

    gintKey = 0

End Sub

'Function Name:     ResetQCTestPlanItems

'Function Purpose:  Increments and returns the unique key ID

'Input Parameters:  None

Public Function GetNextKey() As Integer

    gintKey = gintKey + 1

    GetNextKey = gintKey

End Function

'Function Name:     AddQCTestPlanItem

'Function Purpose:  Inserts an item into the QCTestPlanItems datastructure. This will be read into the treeview so most of these

'                   attributes correlate to treeview attributes

'Input Parameters:  strKey - Unique key for the item

'                   strParentKey - Key of the parent item that owns it

'                   strValue - Value of the node item

Public Sub AddQCTestPlanItem(strKey, strParentKey, strValue, strFullQCPath)

    If QCTestPlanItemsInitialised Then

        ReDim Preserve QCTestPlanItems(UBound(QCTestPlanItems) + 1)

        QCTestPlanItems(UBound(QCTestPlanItems)).strKey = strKey

        QCTestPlanItems(UBound(QCTestPlanItems)).strParentKey = strParentKey

        QCTestPlanItems(UBound(QCTestPlanItems)).strValue = strValue

        QCTestPlanItems(UBound(QCTestPlanItems)).strFullQCPath = strFullQCPath

    Else

        ReDim QCTestPlanItems(0)

        QCTestPlanItems(0).strKey = strKey

        QCTestPlanItems(0).strParentKey = strParentKey

        QCTestPlanItems(0).strValue = strValue

        QCTestPlanItems(0).strFullQCPath = strFullQCPath

        QCTestPlanItemsInitialised = True

    End If

End Sub

'Function Name:     BuildTestPlan

'Function Purpose:  Builds the data structure for the Test Plan. It iterates the folder contents and recursively calls itself.

'Input Parameters:  strParentKey - Key of the parent owning

'                   strNodePath - QC Path of the Node to add to the datastructure

'Modification Date:

Public Sub BuildTestPlan(ByVal strParentKey As String, ByVal strNodePath As String)

    Dim intUniqueKeyNo As Integer

    Dim strThisKey As String

    Dim oSubjectNode As SubjectNode

    Dim ChildSubjectNodes As List

    Dim oChildNode As SubjectNode

    Dim strExpectedPath As String

    Dim TestFact As TestFactory

    Dim TestFilter As TDFilter

    Dim TestList As List

    Dim oTest As Test

    Dim strTestKey As String

    

    'Get the Subject Node

    Set oSubjectNode = TestPlanGetSubjectNode(strNodePath)

    If (oSubjectNode Is Nothing) Then Exit Sub

    

    'Setup the key - Folders always have a key prefix of "f"

    intUniqueKeyNo = GetNextKey

    strThisKey = "f-" & intUniqueKeyNo

    

    'Add this Folder into the datastructure

    Call AddQCTestPlanItem(strThisKey, strParentKey, oSubjectNode.Name, strNodePath)

    

    'Does it have any child folders?

    Set ChildSubjectNodes = oSubjectNode.FindChildren("", False, "")

    If Not (ChildSubjectNodes Is Nothing) Then

        'This gives us a list of all children + subchildren so we need to filter it a bit

        For Each oChildNode In ChildSubjectNodes

            strExpectedPath = strNodePath & "\" & oChildNode.Name

            If strExpectedPath = oChildNode.Path Then

                'It's a direct child so iterate it

                Call BuildTestPlan(strThisKey, strExpectedPath)

            End If

        Next

    End If

    

    'Now it's processed all the child folders, look to see if there are any tests

    Set TestFact = tdc.TestFactory

    Set TestFilter = TestFact.Filter

    TestFilter.Filter("TS_SUBJECT") = Chr(34) & strNodePath & Chr(34)

    Set TestList = TestFact.NewList(TestFilter.Text)

    

    'Scan through all of the tests

    For Each oTest In TestList

        If (oTest.Type = "QUICKTEST_TEST") Then

            'mark it as a QTP test ("q" prefix)

            strTestKey = "q-" & GetNextKey

            Call AddQCTestPlanItem(strTestKey, strThisKey, oTest.Name, strNodePath)

        Else

            'mark it as a normal test ("t" prefix)

            strTestKey = "t-" & GetNextKey

            Call AddQCTestPlanItem(strTestKey, strThisKey, oTest.Name, strNodePath)

        End If

    Next

    

End Sub

###############################################################

To use the above code, copy the code into new modules respectively

Happy coding to test the code ;)