I've got a routine that loads a tree control.
Works a-ok the first time around, then bombs the second. Works the
third, bombs on the fourth....i.e. it works every other time it is
invoked.
Error# always the same: -2214 741 7848, but the message varies between
"Method 'Add' of object INodes failed." and "The object invoked has
disconnected from it's clients." The first one is more common.
Must be something to do with the state of the control. But, for the
life of me, I cannot see anything in the code...but it must be there,
right?
Anybody been here before?
The code: (Google's word wrapping seems to have had it's way with
it...if you're serious about trying to read it, flip an eMail to
20******@FatBel ly.com and I'll ship you an un-wrapped version in a
..txt attachment)
-----------------------------------------------------
Public Function Load_ElementTre e(ByVal theCheckBoxSwit ch As Boolean,
ByRef theTree As Control, ByRef theElementRS As DAO.Recordset,
Optional ByVal theNameFilter As String) As Long
1000 debugStackPush mModuleName & ": Load_ElementTre e"
1001 On Error GoTo Load_ElementTre e_err
' PURPOSE: To load a tree with up to six heirarchy levels
' ACCEPTS: - Switch telling whether-or-not to show a checkbox on
each node
' - Pointer to the tree TB loaded
' - Pointer to DAO recordset containing elements TB
loaded, which must contain the following fields:
' > ElementID: PK to the table that contains detail
informatin for the current entry
' > NameLev1: The name TB used in heirarchy level 1
' > NameLev2...6: As above, but for heirarchy levels 2
through 6
' - Optional string containing a name fragment to filter
the tree for
' RETURNS: Number of fields loaded
'
' NOTES: 1) We only load ACTIVE elements. As far as the user is
concerned, anything with IsDeleted=True
' has fallen off the edge of the earth.
' 2) We're wimping out on the max levels issue. Instead
of writing a loop that concocts sql for
' deeper and deeper levels, we're just in-line coding
for six.
1002 Dim thisDB As DAO.Database
Dim collectionRS As DAO.Recordset
Dim myQuery As DAO.QueryDef
Dim curNode As Node
Dim i As Integer
Dim curNodeText As String
Dim curParentKey As String
Dim prvNameLev1 As String
Dim prvNameLev2 As String
Dim prvNameLev3 As String
Dim prvNameLev4 As String
Dim prvNameLev5 As String
Dim prvNameLev6 As String
Dim curNodeKeyLev1 As String
Dim curNodeKeyLev2 As String
Dim curNodeKeyLev3 As String
Dim curNodeKeyLev4 As String
Dim curNodeKeyLev5 As String
Dim curNodeKeyLev6 As String
Dim loadCount As Long 'number of items actually loaded
Dim itemCount As Long 'strictly for debugging
Dim curNameLev1 As String
Dim curNameLev2 As String
Dim curNameLev3 As String
Dim curNameLev4 As String
Dim curNameLev5 As String
Dim curNameLev6 As String
Dim curElementID As Long
Dim wantRecord As Boolean
1003 DoCmd.Hourglass True
1004 StatusSet "Loading elements..."
1010 With theTree
1011 .Visible = False
1012 .Nodes.Clear
1013 .Checkboxes = theCheckBoxSwit ch
1014 .Indentation = 0
1015 .LineStyle = 1
1016 .Scroll = True
1017 .Sorted = True
1018 .Style = 6
1019 End With
1020 Set thisDB = CurDB()
1040 With theElementRS
1050 Do Until .EOF = True
1051 itemCount = itemCount + 1
1052 curNameLev1 = !NameLev1
1053 curNameLev2 = !NameLev2
1054 curNameLev3 = !NameLev3
1055 curNameLev4 = !NameLev4
1056 curNameLev5 = !NameLev5
1057 curNameLev6 = !NameLev6
1059 curElementID = !ElementID
1060 If Len(theNameFilt er & "") > 0 Then
1061 If InStr(1, !NameLev1, theNameFilter) > 0 Then
1062 wantRecord = True
1063 Else
1064 wantRecord = False
1065 End If
1066 Else
2067 wantRecord = True
2069 End If
1070 If wantRecord = True Then
1079 loadCount = loadCount + 1
1100 If !NameLev1 <> prvNameLev1 Then
1101 prvNameLev1 = !NameLev1
1102 curNodeKeyLev1 = gTreeKeyDelimit er & CStr(!ElementID )
& gTreeKeyDelimit er & "1"
1103 curNodeText = !NameLev1
1109 Set curNode = theTree.Nodes.A dd(, , curNodeKeyLev1,
curNodeText)
1110 prvNameLev2 = "" 'Neccessary to
handle situations where the same field name appears in different
consecutive tables
1111 prvNameLev3 = ""
1112 prvNameLev4 = ""
1113 prvNameLev5 = ""
1119 prvNameLev6 = ""
1199 End If
1200 If !NameLev2 <> prvNameLev2 Then
1201 prvNameLev2 = !NameLev2
1202 If Len(!NameLev2 & "") > 0 Then
1203 curNodeKeyLev2 = gTreeKeyDelimit er &
CStr(!ElementID ) & gTreeKeyDelimit er & "2"
1204 curNodeText = !NameLev2
1205 Set curNode = theTree.Nodes.A dd(curNodeKeyLe v1,
tvwChild, curNodeKeyLev2, curNodeText)
1209 End If
1210 prvNameLev3 = ""
1211 prvNameLev4 = ""
1212 prvNameLev5 = ""
1219 prvNameLev6 = ""
1299 End If
1300 If !NameLev3 <> prvNameLev3 Then
1301 prvNameLev3 = !NameLev3
1302 If Len(!NameLev3 & "") > 0 Then
1303 curNodeKeyLev3 = gTreeKeyDelimit er &
CStr(!ElementID ) & gTreeKeyDelimit er & "3"
1304 curNodeText = !NameLev3
1305 Set curNode = theTree.Nodes.A dd(curNodeKeyLe v2,
tvwChild, curNodeKeyLev3, curNodeText)
1309 End If
1310 prvNameLev4 = ""
1311 prvNameLev5 = ""
1319 prvNameLev6 = ""
1399 End If
1400 If !NameLev4 <> prvNameLev4 Then
1401 prvNameLev4 = !NameLev4
1402 If Len(!NameLev4 & "") > 0 Then
1403 curNodeKeyLev4 = gTreeKeyDelimit er &
CStr(!ElementID ) & gTreeKeyDelimit er & "4"
1404 curNodeText = !NameLev4
1405 Set curNode = theTree.Nodes.A dd(curNodeKeyLe v3,
tvwChild, curNodeKeyLev4, curNodeText)
1409 End If
1410 prvNameLev5 = ""
1411 prvNameLev6 = ""
1499 End If
1500 If !NameLev5 <> prvNameLev5 Then
1501 prvNameLev5 = !NameLev5
1502 If Len(!NameLev5 & "") > 0 Then
1503 curNodeKeyLev5 = gTreeKeyDelimit er &
CStr(!ElementID ) & gTreeKeyDelimit er & "5"
1504 curNodeText = !NameLev5
1505 Set curNode = theTree.Nodes.A dd(curNodeKeyLe v4,
tvwChild, curNodeKeyLev5, curNodeText)
1509 End If
1510 prvNameLev6 = ""
1599 End If
1600 If !NameLev6 <> prvNameLev6 Then
1601 prvNameLev6 = !NameLev6
1602 If Len(!NameLev6 & "") > 0 Then
1603 curNodeKeyLev6 = gTreeKeyDelimit er &
CStr(!ElementID ) & gTreeKeyDelimit er & "6"
1604 curNodeText = !NameLev6
1605 Set curNode = theTree.Nodes.A dd(curNodeKeyLe v5,
tvwChild, curNodeKeyLev6, curNodeText)
1612 End If
1639 End If
1900 curNode.Expande d = False
1901 End If
1902 .MoveNext
1903 Loop
1909 End With
1996 theTree.Visible = True
1997 Load_ElementTre e = loadCount
1998 StatusSet ""
1999 DoCmd.Hourglass False
Load_ElementTre e_xit:
debugStackPop
On Error Resume Next
Set curNode = Nothing
Set myQuery = Nothing
collectionRS.Cl ose
Set collectionRS = Nothing
Set thisDB = Nothing
Exit Function
Load_ElementTre e_err:
bugAlert True, "ItemCount= " & Format$(itemCou nt, "0") & ",
NameLev1='" & curNameLev1 & "', NameLev2='" & curNameLev2 & "',
NameLev3='" & curNameLev3 & "', NameLev4='" & curNameLev4 & "',
NameLev5='" & curNameLev5 & "', NameLev6='" & curNameLev6 & "',
ElementID=" & Format$(curElem entID, "0") & "."
Resume Load_ElementTre e_xit
End Function
-------------------------------------
