Работа с элементом TreeView

Private Sub LoadtvTree()
 Dim db As Database
 Dim rst As Recordset
 Dim Index As Long
 Dim SQL As String
 Dim colNodes As New Collection
 Dim colLevel As New Collection
 Dim ThisNode As New MyNode
 
On Error GoTo Err_cmd
 
' Вытаскиваю из таблицы все папки, упорядоченные по ParentID
 Set db = CurrentDb
 SQL = "SELECT * FROM OutSections ORDER BY ParentID;"
 Set rst = db.OpenRecordset(SQL, dbOpenSnapshot)
 
 With Me!tvTree
    'удаляю все папки из контрола 
    .Nodes.Clear
 
    'добавляю корневую папку в контол
    ThisNode.ID = 0
    ThisNode.ParentID = 0
    ThisNode.Name = "Корневая папка"
    .Nodes.Add , , "Nod" & CStr(ThisNode.ID), ThisNode.Name, "Folder", "OpenFolder"
 
    'добавляю папку в коллекцию 'уровень'
    colLevel.Add ThisNode, CStr(ThisNode.ID)
    Set ThisNode = Nothing
    'все папки из таблицы - в colNodes
    Do While Not rst.EOF
        ThisNode.ID = rst!ID
        ThisNode.ParentID = rst!ParentID
        ThisNode.Name = rst!OutSection
        colNodes.Add ThisNode, CStr(ThisNode.ID)
        Set ThisNode = Nothing
        rst.MoveNext
    Loop
    rst.Close
    
 ' Дальнейший код могу описать только на уровне идеи 
 ' Дерево строиться по уровням, от корня.
 ' Пользуясь возможностью добавлять в коллекцию элеменыт 
 ' на указанное место, за один проход по colLevel добавляю в Me.tvTree
 ' и в  colLevel  все папки, подчиненные текущей, но добавляю их перед ней
 ' (в  colLevel), а из colNodes я их удаляю.
 ' В результате у меня в colLevel набирается следующий уровень.
 ' Когда colLevel  опустел - все папки в Me.tvTree.
 ' 
 ' Алгоритм делал еще в VB5, там было и перетаскивание -
 ' меняется только ParentID. Работает железно. 
 ' Если из других мест ParentID не менять, то потерянные ветки не появляются
 ' принципиально!
    
    Index = 1
    Set ThisNode = Nothing
    'Внешний цикл по colLevel
    Do While Index <= colLevel.Count
    'Внутренний цикл по colNodes
        For Each ThisNode In colNodes       
            If ThisNode.ParentID = colLevel.Item(Index).ID Then
        ' ВЫбрана папка (ThisNode), 
        ' подчиненная текущей папке в colLevel,
        ' добавляю ее в Me.tvTree, 
                Me.tvTree.Nodes.Add "Nod" & CStr(colLevel.Item(Index).ID), 
                tvwChild, "Nod" & ThisNode.ID,
                ThisNode.Name, "Folder", "OpenFolder"
        ' Добавляю ее в colLevel
                colLevel.Add ThisNode, CStr(ThisNode.ID), CStr(colLevel(Index).ID)
        'Инкремент переменной Index
                Index = Index + 1
        'Удаляю папку из colNodes
                colNodes.Remove (CStr(ThisNode.ID))
            End If
    ' Перехожу к следующей папке в colLevel
        Next ThisNode
    'Если в colLevel еще есть элементы
        If colLevel.Count <> 0 Then
        ' Удаляю папку, для которой добавил все подчиненные 
        ' папки из colNodes с удалением их из colNodes
            colLevel.Remove (Index)
            Index = 1
        Else
            Index = 0
        End If
    
    Loop ' Index <= colLevel.Count
    
 End With
 
Exit_cmd:
    Exit Sub
 
Err_cmd:
    MsgBox Err.Description
    Resume Exit_cmd
 
End Sub