Create various entities and link them
Public Function LinkDefectsToEntities(folder As SubjectNode, _
                oTest As Test) As Boolean

' Create various entities and link them

'-----------------------------------------------------------
' This example creates a test and a test set with test steps.
' It then creates three defects and links them to the test,
' the run, and the test step.
'-----------------------------------------------------------
    Dim testF As TestFactory
'    Dim oTest As Test
'    Dim StepF As DesignStepFactory
    Dim desstep As DesignStep
    'Dim oRoot As SubjectNode, folder As SubjectNode
    Dim TreeMgr As TreeManager
    Dim labTreeMgr As TestSetTreeManager
    Dim labFolder As SysTreeNode, labTreeRoot As SysTreeNode
    Dim BugF As BugFactory
    Dim Bug1 As Bug, Bug2 As Bug, bug3 As Bug
    Dim testSetF As TestSetFactory
    Dim TstSet As TestSet
    Dim testInstanceF As TSTestFactory
    Dim tstInstance As TSTest
    Dim RunF As RunFactory
    Dim theRun As Run
    Dim runStepF As StepFactory
    Dim runStep As Step, runStep2 As Step
    Dim testID As String
    Dim lst As List, Item
    Dim TestName As String
    
    On Error GoTo LinkDefectsToEntitiesErr
    TestName = oTest.name
    
'tdc is a TDConnection object. When this routine is run,
' the user is authenticated and connected to the project.
    Set TreeMgr = tdc.TreeManager
    Set testF = tdc.TestFactory
    Set labTreeMgr = tdc.TestSetTreeManager
    Set BugF = tdc.BugFactory
'------------------------------------------
' Test Plan
'------------------------------------------
 Get or create a test plan subject folder.
    errmsg = "Subject tree error"
    Set oRoot = TreeMgr.TreeRoot("Subject")
    On Error Resume Next
    Set folder = oRoot.FindChildNode(FolderName)
    On Error GoTo LinkDefectsToEntitiesErr
    If folder Is Nothing Then _
        Set folder = oRoot.AddNode(FolderName)


'' Create a design test.
    errmsg = "Design test error"
    ' Get the test if it exists.
    ' For the code of GetTest, see the Test object example:
    '  "Get a test object with name and path"
    Set oTest = GetTest(TestName, FolderName)
    ' If the test doesn't exist, create it.
    If oTest Is Nothing Then
        Set oTest = testF.AddItem(Null)
        oTest.name = TestName
        oTest.Type = "MANUAL"
        ' Put the test in the new subject folder.
        oTest.Field("TS_SUBJECT") = folder.NodeID
        oTest.Post
    End If
 

'' Get or create a design step from the factory of the new test.
    errmsg = "Design step error"
    Set StepF = oTest.DesignStepFactory
    Dim aFilter As TDFilter
    Set aFilter = StepF.Filter
    Dim StepName$
    StepName = TestName & "Step_1"
    aFilter.Filter("DS_STEP_NAME") = StepName
    Set lst = StepF.NewList(aFilter.Text)
    If lst.Count = 0 Then
        Set desStep = StepF.AddItem(Null)
        desStep.StepName = StepName
        desStep.StepDescription = "Step to be linked to defect."
        desStep.StepExpectedResult = "This step expected to be linked."
        desStep.Post
    Else
        Set desStep = lst.Item(1)
    End If

    Dim StepName$
    StepName = oTest.name & "Step_1"
    Set desstep = GetDesignStep(oTest, StepName, _
            "Step to be linked to defect", _
            "This step expected to be linked.")
    
'-----------------------------------------
' Test Lab
'------------------------------------------
' Get or create a test set folder.
    errmsg = "Lab node error"
    Dim tsFolderName$, tsFolderPath$
    tsFolder = FolderName & "_TS"
    tsFolderPath = "Root\" & tsFolder
    On Error Resume Next
    Set labFolder = AddTestSetFolder("LinkTestSets")
    
    Set labFolder = labTreeMgr.NodeByPath(tsFolderPath)
    On Error GoTo LinkDefectsToEntitiesErr
    If labFolder Is Nothing Then
        Set labTreeRoot = labTreeMgr.Root
        Set labFolder = labTreeRoot.AddNode(tsFolder)
        labTreeRoot.Post
    End If

' Get or create a test set from the factory of the new folder.
    errmsg = "Test set error"
    Dim tsName$
    tsName = TestName & "_TS"
    Set testSetF = labFolder.TestSetFactory
    Set aFilter = testSetF.Filter
    aFilter.Filter("CY_CYCLE") = tsName
    Set lst = testSetF.NewList(aFilter.Text)
    If lst.Count = 0 Then
        Set TstSet = testSetF.AddItem(Null)
        TstSet.Field("CY_CYCLE") = tsName
        TstSet.Post
    Else
        Set TstSet = lst.Item(1)
    End If
  Set TstSet = GetTestSet(labFolder, "LinkTestTS", "Open")
   
' Get or create a test instance from the factory of the new test set.
    errmsg = "Test instance error"
    Set testInstanceF = TstSet.TSTestFactory
    Set aFilter = testInstanceF.Filter
    aFilter.Filter("TC_TEST_ID") = oTest.ID
    Set lst = testInstanceF.NewList(aFilter.Text)
    If lst.Count = 0 Then
        Set tstInstance = testInstanceF.AddItem(Null)
    ' Put the new test in the test set.
        tstInstance.Field("TC_TEST_ID") = oTest.ID
    Else
        Set tstInstance = lst.Item(1)
    End If
    tstInstance.Status = "No Run"
    tstInstance.Post
    Set tstInstance = GetTestInstance(TstSet, oTest)
    
    
' Create a run of the test instance.
    errmsg = "Run error"
    Dim RunName$
    RunName = TestName & "Linked_Run"
    Set RunF = tstInstance.RunFactory
    Set theRun = RunF.AddItem(RunName)
    theRun.Status = "FAILED"
    theRun.Post
    Set theRun = NewTestInstanceRun(tstInstance, _
            "FAILED", RunName$)
    
'Get the design step created above for the test
' to be associated with this test run.
    errmsg = "Design steps error"
    theRun.CopyDesignSteps
    theRun.Post
    
' Add the steps to run and fail them.
    Set runStepF = theRun.StepFactory
    Set lst = runStepF.NewList("")
    For Each Item In lst
     Set runStep2 = Item
     runStep2.Status = "Failed"
     runStep2.Post
    Next
    Dim stepCt As Integer
    stepCt = SetRunStepsStatus(theRun, "Failed")
    MsgBox stepCt
    
    
'------------------------------------------
' Defect Module
'------------------------------------------
' Create new defects.
    Dim bSummary As String
    
    errmsg = "Create Bugs error"
    Set Bug1 = BugF.AddItem(Null)
    Bug1.Summary = "Associated to " & TestName
    Bug1.Status = "New"
    Bug1.Priority = "3-High"
    Bug1.Field("BG_SEVERITY") = "3-High"
    Bug1.DetectedBy = c_qcUser
    Bug1.Field("BG_DETECTION_DATE") = Date
    Bug1.Post
    
    bSummary = "Associated to " & oTest.name
    Set Bug1 = NewBug(bSummary, "Bug1 LinkDefectsToEntities", c_qcUser, "3-High")
    
    errmsg = "Create Bug2 error"
    Set Bug2 = BugF.AddItem(Null)
    Bug2.Summary = "Associated to " & RunName
    Bug2.Status = "New"
    Bug2.Priority = "3-High"
    Bug2.Field("BG_SEVERITY") = "3-High"
    Bug2.DetectedBy = c_qcUser
    Bug2.Field("BG_DETECTION_DATE") = Date
    Bug2.Post
    bSummary = "Associated to " & theRun.name
    Set Bug2 = NewBug(bSummary, "Bug2 LinkDefectsToEntities", c_qcUser, "3-High")
    
    errmsg = "Create Bug2 error"
    Set bug3 = BugF.AddItem(Null)
    bug3.Summary = "Associated to Run Step " & TestName & ":" & runStep2.name
    bug3.Status = "New"
    bug3.Priority = "3-High"
    bug3.Field("BG_SEVERITY") = "3-High"
    bug3.DetectedBy = c_qcUser
    bug3.Field("BG_DETECTION_DATE") = Date
    bug3.Post
    bSummary = "Associated to Run Step " & oTest.name & ":" & runStep2.name
    Set bug3 = NewBug(bSummary, "Bug3 LinkDefectsToEntities", c_qcUser, "3-High")

' Add associations between diffent entities and bugs.
    Dim BugLinkF As LinkFactory
    Dim b2Test As Link, b2Run As Link, b2Step As Link
    Dim testL As ILinkable, runL As ILinkable, stepL As ILinkable
    Dim anObj As Object
    
' Cast test to Ilinkable and get bug link factory.
    errmsg = "Error linking Bug1"
    Set testL = oTest
    Set BugLinkF = testL.BugLinkFactory
    
' Create a link between Bug1 and the test.
    Set b2Test = BugLinkF.AddItem(Bug1)
    b2Test.LinkType = "Related"
    b2Test.Post

' Show the link definition.
    Set anObj = b2Test.LinkedByEntity
    Debug.Print TypeName(anObj), anObj.name 'ITest LinkTest
    Set anObj = b2Test.SourceEntity
    Debug.Print TypeName(anObj), anObj.name 'ITest LinkTest
    Set anObj = b2Test.TargetEntity
    Debug.Print TypeName(anObj), anObj.Summary 'IBug   Associated to LinkTest
 
' Cast Bug2 to Ilinkable and get bug link factory.
    errmsg = "Error linking Bug2"
    Set runL = theRun
    Set BugLinkF = runL.BugLinkFactory

' Create a link between Bug2 and the run.
    Set b2Run = BugLinkF.AddItem(Bug2)
    b2Run.Status = "No Run" 'Always set a status when creating a run
    b2Run.LinkType = "Related"
    b2Run.Post

'Show the link definition
    Set anObj = b2Run.LinkedByEntity
    Debug.Print TypeName(anObj), anObj.name 'IRun2  LinkTestLinked_Run
    Set anObj = b2Run.SourceEntity
    Debug.Print TypeName(anObj), anObj.name 'IRun2  LinkTestLinked_Run
    Set anObj = b2Run.TargetEntity
    Debug.Print TypeName(anObj), anObj.Summary 'IBug Associated to LinkTestLinked_Run

' Cast Bug3 to Ilinkable and get bug link factory.
    errmsg = "Error linking Bug3"
    Set stepL = runStep2
    Set BugLinkF = stepL.BugLinkFactory
    
' Create a link between Bug3 and the run step.
    Set b2Step = BugLinkF.AddItem(bug3)
    b2Step.LinkType = "Related"
    b2Step.Post
    
' Show the link definition.
    Set anObj = b2Step.LinkedByEntity
    Debug.Print TypeName(anObj), anObj.name 'IStep2  LinkTestStep_1
    Set anObj = b2Step.SourceEntity
    Debug.Print TypeName(anObj), anObj.name 'IStep2  LinkTestStep_1
    Set anObj = b2Step.TargetEntity
    Debug.Print TypeName(anObj), anObj.Summary 'IBug Associated to Run Step LinkTest:LinkTestStep_1
 
'Show the link definition from the bug side.
'Note that source and target are reversed.
    Dim bugL As ILinkable, lList As List, aLink As Link
    Dim bugLF As LinkFactory
    Set bugL = bug3
    Debug.Print
    Set bugLF = bugL.LinkFactory
    Set lList = bugLF.NewList("")
    For Each aLink In lList
        Set anObj = aLink.LinkedByEntity
        Debug.Print TypeName(anObj), anObj.name  ' IStep2 LinkTestStep_1
        Set anObj = aLink.SourceEntity
        Debug.Print TypeName(anObj), anObj.Summary ' IBug Associated to Run Step LinkTest:LinkTestStep_1
        Set anObj = aLink.TargetEntity
        Debug.Print TypeName(anObj), anObj.name  'IStep2 LinkTestStep_1
    Next aLink
CLEANUP:
    On Error GoTo CLEANUPERR
    LinkDefectsToEntities = SUCCESS
    errmsg = "Failure deleting defects"
    If util_DeleteBug(Bug1) Or util_DeleteBug(Bug2) Or util_DeleteBug(bug3) Then
        LinkDefectsToEntities = VALIDATE_FAILURE
    End If
    
    errmsg = "Failure deleting labFolder"
    If DeleteTestSetFolder(labFolder, True) Then
        LinkDefectsToEntities = VALIDATE_FAILURE
    End If
    
Exit Function
LinkDefectsToEntitiesErr:
    LinkDefectsToEntities = FAILURE
    GoTo CLEANUP
CLEANUPERR:
     LinkDefectsToEntities = FAILURE
End Function

Defect to defect links