I am using the following code to recursively populate a treeview control. I modified it from the code found at MS's website.
Here is my problem. The code adds nodes to the tree as follows:
Emp1
--Emp2
--Emp3
--Emp4
It then errors out because it seems to stay on Emp4 and continue to try to add rather than continuing to list the employees that report to Emp3.
What am I doing wrong?
Phil Edwards
Code:
'==================================================================
'This procedure populates the TreeView control when the form opens.
'==================================================================
Private Sub Form_Load()
On Error GoTo ErrForm_Load
Dim rst As ADODB.Recordset
Dim nodCurrent As Node, nodRoot As Node
Dim objTree As TreeView
Dim strText As String
Dim bk As Variant
Set rst = New ADODB.Recordset
rst.CursorType = adOpenStatic
rst.CursorLocation = adUseClient
rst.Open "tblEmployee", cnn1
'Create a reference to the TreeView Control.
Set objTree = Me!xTree.Object
'Find the first employee who is a supervisor.
rst.MoveFirst
rst.Find ("ReportsTo = Null")
'Build the TreeView list of supervisors and their tblEmployee.
Do Until rst.EOF
'Extract the supervisor's name.
strText = rst![EmployeeLName] & (", " + rst![EmployeeFName])
'Add a root level node to the tree for the supervisor.
Set nodCurrent = objTree.Nodes.Add(, , "a" & rst!EmployeeID, _
strText)
'Use a placeholder to save this place in the recordset.
bk = rst.Bookmark
'Run a recursive procedure to add all the child nodes
'for tblEmployee who report to this supervisor.
AddChildren nodCurrent, rst
'Return to your placeholder.
rst.Bookmark = bk
'Find the next supervisor.
rst.Find ("ReportsTo = Null")
Loop
ExitForm_Load:
Exit Sub
ErrForm_Load:
MsgBox Err.Description, vbCritical, "Form_Load"
Resume ExitForm_Load
End Sub
'===================================================================
'This procedure adds child nodes to the tree for all tblEmployee who
'report to a particular supervisor, and calls itself recursively
'to add child nodes for all other tblEmployee they supervise.
'
'Note that this procedure accepts the open tblEmployee recordset by
'reference so you do not have to open a new recordset for each call.
'===================================================================
Sub AddChildren(nodBoss As Node, rst As Recordset)
On Error GoTo ErrAddChildren
Dim nodCurrent As Node
Dim objTree As TreeView
Dim strText As String
Dim bk As Variant
'Create a reference to the TreeView control.
Set objTree = Me!xTree.Object
rst.MoveFirst
'Find the first employee who reports to the supervisor for this node.
rst.Find "[ReportsTo] =" & Mid(nodBoss.Key, 2)
'Build the list of tblEmployee who report to this supervisor.
Do Until rst.EOF
'Extract the employee's name.
strText = rst![EmployeeLName] & (", " + rst![EmployeeFName])
'Add as a child node to the tree.
Set nodCurrent = objTree.Nodes.Add(nodBoss, tvwChild, "a" & _
rst!EmployeeID, strText)
'Save your place in the recordset.
bk = rst.Bookmark
'Add any tblEmployee for whom the current node is a supervisor.
AddChildren nodCurrent, rst
'Return to your place in the recordset and continue to search.
rst.Bookmark = bk
'Find the next employee who reports to this supervisor.
rst.Find "[ReportsTo]=" & Mid(nodBoss.Key, 2), , , bk
Loop
ExitAddChildren:
Exit Sub
ErrAddChildren:
MsgBox "Can't add child: " & Err.Description, vbCritical, _
"AddChildren(nodBoss As Node) Error:"
Resume ExitAddChildren
End Sub
Here is my problem. The code adds nodes to the tree as follows:
Emp1
--Emp2
--Emp3
--Emp4
It then errors out because it seems to stay on Emp4 and continue to try to add rather than continuing to list the employees that report to Emp3.
What am I doing wrong?
Phil Edwards