Option Compare Database
Option Explicit
Private mTVW As clsTreeview
Private mNodeQueryName As String
Private mRootParentID As Variant
Private mRecordSet As DAO.Recordset
Private mNodeIDfield As String
Private mParentIDfield As String
Private mNodeTextField As String
Private mNodeLevelField As String
'To use this module for loading records either by individual level or recursively create queries as follows.
'Each query needs the following fields
'NodeID: This should be a concatenated field of the PK with the NodeLevel
'NodeText: This should be a concatenated field for the caption of what is visible
'NodeLevel: This should identify what level of the tree only needed for non recursive calls. Can be the name of the table
'ParentID: This is the concatenated field of the the ParentID foreign key and the ParentNodeLevel
'Example
'SELECT [NodeLevel] & "_" & [Order ID] AS NodeID, "Order: " & [Order ID] & " Order Date: " & [Order Date] AS NodeText, "Order" AS NodeLevel,
'Employee" & "_" & [orders].[employee id] AS ParentID,
'FROM Orders
Public Sub InitializLoader(Treeview As clsTreeview)
On Error GoTo ErrHandler
Set mTVW = Treeview
Exit Sub
ErrHandler:
MsgBox ("Error: " & Err.Number _
& " " & Err.Description _
& " " & Err.Source)
Resume Next
End Sub
Public Sub AddRecursiveRecords(NodeQueryName As String, RootParentID As String)
'Parent and Child IDs are numeric see the instructions on concatenation to make them strings
Dim strCriteria As String
Dim bk As String
Dim NodeID As String
Dim NodeText As String
Dim CurrentNode As clsNode
Dim NodeLevel As String
Set Me.NodeRecordset = CurrentDb.OpenRecordset(NodeQueryName, dbOpenDynaset)
strCriteria = "ParentID = '" & RootParentID & "'"
Me.NodeRecordset.FindFirst strCriteria
If Me.NodeRecordset.NoMatch Then
MsgBox "There is no record with a Parent ID of " & RootParentID
End If
Do Until Me.NodeRecordset.NoMatch
NodeID = Me.NodeRecordset.Fields("NodeID")
NodeText = Me.NodeRecordset.Fields("NodeText")
NodeLevel = Me.NodeRecordset.Fields("NodeLevel")
Set CurrentNode = Me.Treeview.AddRoot(NodeID, NodeText)
With CurrentNode
.Tag = NodeLevel
.Bold = True
.Expanded = False
End With
bk = Me.NodeRecordset.Bookmark
Call AddRecursiveBranch(NodeID, NodeLevel, CurrentNode)
'ensure you return back to where you were since the bookmark is moving in recursive calls
Me.NodeRecordset.Bookmark = bk
Me.NodeRecordset.FindNext strCriteria
Loop
Me.Treeview.Refresh
End Sub
Private Sub AddRecursiveBranch(ByVal ParentID As Variant, ByVal NodeLevel, ParentNode As clsNode)
On Error GoTo errLable
Dim strCriteria As String
Dim bk As String
Dim NodeID As String
Dim NodeText As String
Dim CurrentNode As clsNode
strCriteria = "ParentID = '" & ParentID & "'"
Me.NodeRecordset.FindFirst strCriteria
Do Until Me.NodeRecordset.NoMatch
NodeID = Me.NodeRecordset.Fields("NodeID")
NodeText = Me.NodeRecordset.Fields("NodeText")
NodeLevel = Me.NodeRecordset.Fields("NodeLevel")
Set CurrentNode = ParentNode.AddChild(NodeID, NodeText)
With CurrentNode
.Tag = NodeLevel
.Bold = False
.Expanded = False
End With
bk = Me.NodeRecordset.Bookmark
'Recursive call
Call AddRecursiveBranch(NodeID, NodeLevel, CurrentNode)
Me.NodeRecordset.Bookmark = bk
Me.NodeRecordset.FindNext strCriteria
Loop
Exit Sub
errLable:
MsgBox Err.Number & " " & Err.Description & " In addBranch"
If MsgBox("Do you want to exit the loop?", vbYesNo, "Error In Loop") = vbYes Then
Exit Sub
Else
Resume Next
End If
End Sub
Public Sub AddRecordsByLevel(NodeQueryName As String, NodeLevel As String, Optional IsRootLevel = False)
'Ensure query has these fields see instructions
'Node level needs to match the query see instructions
On Error GoTo ErrHandler
Dim NodeID As String
Dim NodeText As String
Dim CurrentNode As clsNode
Dim ParentID As String
Dim ParentNode As clsNode
Dim Key As String
Set Me.NodeRecordset = CurrentDb.OpenRecordset(NodeQueryName, dbOpenDynaset)
Do While Not Me.NodeRecordset.EOF
NodeID = Me.NodeRecordset.Fields("NodeID")
NodeText = Me.NodeRecordset.Fields("NodeText")
NodeLevel = Me.NodeRecordset.Fields("NodeLevel")
If IsRootLevel Then
Set CurrentNode = Me.Treeview.AddRoot(NodeID, NodeText)
With CurrentNode
.Tag = NodeLevel
.Bold = True
.Expanded = False
End With
Else
ParentID = Me.NodeRecordset.Fields("ParentID")
Set ParentNode = Me.Treeview.Nodes(ParentID)
Set CurrentNode = ParentNode.AddChild(NodeID, NodeText)
With CurrentNode
.Tag = NodeLevel
'.Bold = True
.Expanded = False
End With
End If
Me.NodeRecordset.MoveNext
Loop
'create the node controls and display the tree
Me.Treeview.Refresh
Exit Sub
ErrHandler:
MsgBox ("Error: " & Err.Number _
& " " & Err.Description _
& " " & Err.Source)
If MsgBox("Do you want to exit the loop?", vbYesNo, "Error In Loop") = vbYes Then
Exit Sub
Else
Resume Next
End If
End Sub
Public Property Get NodeRecordset() As DAO.Recordset
Set NodeRecordset = mRecordSet
End Property
Public Property Set NodeRecordset(NewNodeRecordSet As DAO.Recordset)
Set mRecordSet = NewNodeRecordSet
End Property
Public Property Get Treeview() As clsTreeview
Set Treeview = mTVW
End Property