gistfile1.vb

Public Function GetSubjectNodeByPath(ByVal fullPath As String, _
    Optional delimChar As String = "\") _
        As SubjectNode

' This function returns the Test SubjectNode object
' corresponding to the lowest level of a path.
' The path format is:
' "OTA_DEMO_SUBJECT\OTA_SUBJECT_level1\OTA_SUB_1.1\OTA_SUB_1.1.1\OTA_SUB_1.1.1.1"
' If a backslash is not used as the folder delimiter, any other
' character can be passed in the delimChar arguement.
    Dim TreeMgr As TreeManager
    Dim SubjRoot As SubjectNode
    Dim SubNode As SubjectNode
    Dim Trees As List
    Dim CurrentSubName As String

    On Error GoTo GetSubjectNodeByPathErr

' Get the list of subject root nodes from the tree manager.
' There is only one item in this list.
    'tdc is the global TDConnection object.
    CurrentSubName = "Set TreeMgr = tdc.TreeManager"
    Set TreeMgr = tdc.TreeManager
'----------------------------------------------------------
' Use TreeManager.RootList to get the Subject root.
    Set Trees = TreeMgr.RootList(TDOLE_SUBJECT)
' Get the name of the subject tree root in your project.
    CurrentSubName = Trees.Item(1)
'----------------------------------------------------------
' Use TreeManager.TreeRoot to get the root node object
' from the tree manager by name.
    Set SubjRoot = TreeMgr.TreeRoot(CurrentSubName)
' If fullPath is empty string, return the root.
    If Len(fullPath) = 0 Then
        Set GetSubjectNodeByPath = SubjRoot
        Exit Function
    End If
' Trim the fullPath and strip leading and trailing delimiters.
    fullPath = Trim(fullPath)
    Dim pos%, ln%

    pos = InStr(1, fullPath, delimChar)
    If pos = 1 Then
        fullPath = Mid(fullPath, 2)
    End If
    pos = InStr(fullPath, CurrentSubName)
    If pos = 1 Then
        fullPath = Mid(fullPath, Len(CurrentSubName) + 2)
    End If

    ln = Len(fullPath)
    pos = InStr(ln - 1, fullPath, delimChar)
    If pos > 0 Then
        fullPath = Mid(fullPath, 1, ln - 1)
    End If

' Set up to walk the tree.
    Set SubNode = SubjRoot
' Split the path into individual node names.
    Dim subjectArray() As String
    subjectArray = Split(fullPath, delimChar)

' If path is not directly under root then
' walk down path.
    If LBound(subjectArray) < UBound(subjectArray) Then
        Dim idx%
    ' Debug.Print LBound(subjectArray), UBound(subjectArray)
        For idx = LBound(subjectArray) To UBound(subjectArray) - 1
            CurrentSubName = subjectArray(idx)
' Debug.Print SubjRoot.Name & delimChar & CurrentSubName
'---------------------------------------------------------------
' Use SubjectNode.FindChildNode to get a specifed node.
            Set SubNode = SubjRoot.FindChildNode(CurrentSubName)
            Set SubjRoot = SubNode 'for next loop
        Next idx
    End If 'lbound < ubound

' Get the last node.
    CurrentSubName = subjectArray(UBound(subjectArray))
    Debug.Print SubjRoot.Name & delimChar & CurrentSubName
    Set SubNode = SubjRoot.FindChildNode(CurrentSubName)
' Debug.Print subNode.Name
' Return the last node.
    Set GetSubjectNodeByPath = SubNode
Exit Function
GetSubjectNodeByPathErr:
    On Error Resume Next
    Dim errmsg$
    errmsg = "Error processing " & vbCrLf & fullPath _
        & vbCrLf & "near " & CurrentSubName
    Set GetSubjectNodeByPath = Nothing
    ErrHandler err, "GetSubjectNodeByPath", errmsg, NON_FATAL_ERROR
End Function