Per Douglas J. Steele:
What's the error message you're getting. If you are using distinct Key
values, perhaps you'd better post the code.
As you've probably guessed: "35602: Key is not unique in collection"
My problem is that it seems like I should get that error for the same key value
each time I iterate through the table to load it.
Instead, it pops on a different record each time.
If there aren't any latency issues with the Tree's node collection, I guess I'll
have to put it down to something unusually dumb by Yours Truly.
Here's the code, but only because somebody asked for it. Any field that ends
in "...ID" is an autonumbered PK. Doesn't mean it's unique within the input
RS, though because the joins involved in the query that generates it create
multiple lines with similar values in some columns.
It's going out the window on line 1406.
===================================================
Public Function DealTreeLoad_ByDeal(ByVal theExpandAllSwitch As Boolean, ByVal
theSelectWhat As Long, ByVal theSortSpec As String, ByVal theCollateralManagerID
As Variant, ByVal theClosingDateFrom As Variant, ByVal theClosingDateTo As
Variant, ByVal theDealStatusID As Variant, ByVal theUnderwriterID As Variant,
ByRef theTree As Control, ByRef thePrvRootNode As Node) As Long
1000 debugStackPush mModuleName & ": DealTreeLoad_ByDeal"
1001 On Error GoTo DealTreeLoad_ByDeal_err
' PURPOSE: To load a tree control with deals and any component tranches,
making the
' highest level of the tree the DealName
' ACCEPTS: - Switch telling if all nodes SB expanded as they are created
' - ORDER BY specs for the sort statement. e.g. ".ClosingDate DESC,
..DealName ASC". The rest of the statement is in constant mDealTreeLoadSQL.
' - Pointer to the tree TB loaded
' - Pointer to a Node object used by the calling form to track the
last root node selected.
' This enables the calling form to collapse each node as the user
moves to the
' next root node.
' - Optional value for ID of CollateralManager tb selected
' - Optional value for "From" ClosingDate range tb selected
' - Optional value for "To" ClosingDate range tb selected
' - Optional value for ID of Deal's Status tb selected
' - Optional value for ID of Underwriter tb selected
' - Optional switch telling to select all records
' - Optional switch that requests sort by ascending ClosingDate
' - Optional switch that requests sort by descending ClosingDate
' RETURNS: Number of nodes loaded
'
' NOTES: 1) The calling routine is responsible for not sending us more
nodes than the tree control
' can handle. See "mNodeLimit" constant.
' 2) This code can handle up to six levels of indentation.
' It cannot handle infinite because we wimped out on the *real*
solution -
' hard-coding it here instead of dynamically modifying SQL
depending on # of children.
' We have genericized to "NameLev1", "NameLev2".... and so-forth.
' In this case, the deal's name is "NameLev1" and each tranch's
name is "NameLev2"... which
' must be assigned by the input query.
' 3) THIS CODE IS INTERTWINED WITH THE INPUT QUERY. You cannot
understand this code unless you
' can see the input query. Especially note that the
mNameLevelLit... constants relate to
' certain columns in the query and are used when
constructing/decoding node keys.
' 3) At least one optional parm must be specified - we use it to
determine which query to
' base the process on.
'
1002 Dim thisDB As DAO.Database
Dim inputRS As DAO.Recordset
Dim myQuery As DAO.QueryDef
Dim curNode As Node
Dim myDebugNode As Node
Dim i As Integer
Dim curDealID As Long
Dim curRecID As Long
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 'Not currently used, but needed for
BugAlert
Dim curNodeTagLev1 As String
Dim curNodeTagLev2 As String
Dim curNodeTagLev3 As String
Dim curNodeTagLev4 As String
Dim curNodeTagLev5 As String
' Dim curNodeTagLev6 As String
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 'Not currently used, but needed for
BugAlert
Dim curRecIdList As String
Dim myNodeKeyRoot As String
Dim wantRecord As Boolean
Dim myLev1Count As Long 'The number of deals loaded.
Dim myRecsLoaded As Long 'number of records successfully loaded -
always less than node count BC one field generates at least 2 nodes
Dim okToProceed As Boolean
Dim myNodeCount As Long 'total number of nodes loaded
Dim myInputCount As Long 'total number of records in input RS
Dim myInputEstimate As Long
Dim mySQL As String
Dim curErr As Long
1003 DoCmd.Hourglass True
1004 StatusSet "Loading deals..."
1005 DoCmd.Echo False
1006 DoEvents
1009 Set thisDB = curDB()
'
----------------------------------------------------------------------------------
' Determine which query we are going to use to load the temp table
1010 Select Case theSelectWhat
Case gSelect_All
1021 Set myQuery = thisDB.QueryDefs("qryDealTreeLoad_AllDeals")
1029 okToProceed = True
1030 Case gSelect_CollateralManager
1031 If IsNumeric(theCollateralManagerID) Then
1032 Set myQuery =
thisDB.QueryDefs("qryDealTreeLoad_SelectedCollateralManager")
1033 myQuery.Parameters("theCollateralManagerID") =
theCollateralManagerID
1034 okToProceed = True
1035 Else
1036 MsgBox "You did not specify a collateral manager.", vbExclamation,
"Cannot Load"
1039 End If
1040 Case gSelect_ClosingDate
1041 If ((IsDate(theClosingDateFrom) = True) And (IsDate(theClosingDateTo)
= True)) Then
1042 Set myQuery =
thisDB.QueryDefs("qryDealTreeLoad_SelectedClosingDateRange")
1043 With myQuery
1044 .Parameters("theDateFrom") = theClosingDateFrom
1049 .Parameters("theDateTo") = theClosingDateTo
1050 End With
1051 okToProceed = True
1052 Else
1053 MsgBox "One or both closing dates illegal: From='" &
theClosingDateFrom & ", To='" & theClosingDateTo & "'.", vbExclamation, "Cannot
Load"
1059 End If
1060 Case gSelect_Status_Deal
1061 Set myQuery = thisDB.QueryDefs("qryDealTreeLoad_SelectedDealStatus")
1069 okToProceed = True
1070 Case gSelect_Underwriter
1071 If IsNumeric(theUnderwriterID) Then
1072 Set myQuery =
thisDB.QueryDefs("qryDealTreeLoad_SelectedUnderwriter")
1073 myQuery.Parameters("theUnderwriterID") = theUnderwriterID
1074 okToProceed = True
1075 Else
1076 MsgBox "You did not specify an underwriter", vbExclamation,
"Cannot Load"
1079 End If
1080 Case Else
1089 BugAlert True, "Unexpected Select Spec=' & theselectwhat & " '."
1099 End Select
'
----------------------------------------------------------------------------------
' Create the work table and open up a recordset into it
1100 If okToProceed = True Then
1101 okToProceed = False
1102 WorkTable_Create "ttblDealTreeLoad", "zmtblDealTreeLoad"
1103 myQuery.Execute dbFailOnError 'Populate
work table depending on what selection query used
1104 mySQL = mDealTreeLoadSQL & theSortSpec
1105 Set inputRS = CurrentDb.OpenRecordset(mySQL, dbOpenDynaset) 'Open up
RecordSet into work table that is sorted as specified
1109 With inputRS
1110 If Not ((.BOF = True) And (.EOF = True)) Then
1111 okToProceed = True
1112 End If
1113 End With
1119 End If
'
----------------------------------------------------------------------------------
' Initialize the tree, then load it from the temp table we just created
1130 If okToProceed = True Then
1131 With theTree
1132 .Nodes.clear
1133 .Checkboxes = False
1134 .Indentation = 0
1135 .LineStyle = 1
1136 .Scroll = True
1139 .Sorted = False 'MUY
IMPORTANTE: Otherwise tree will be sorted by NameLev1
1140 .Style = 6
'1121 myNodeKeyRoot = mTreeTagDelimiter & "000" & mTreeTagDelimiter & "0"
'1122 Set curNode = .Nodes.Add(, , myNodeKeyRoot, "Deals")
1149 End With
'1130 curNode.Expanded = theExpandAllSwitch
1150 With inputRS
1151 If Not ((.BOF = True) And (.EOF = True)) Then
1153 .MoveLast
1154 myInputCount = .RecordCount
1159 SysCmd acSysCmdInitMeter, "Loading " & Format$(.RecordCount,
"#,##0") & " nodes...", myInputCount
1170 .MoveFirst
1171 Do Until .EOF = True
1172 curRecID = !LocalRecordID
1173 curDealID = !DealID
1174 itemCount = itemCount + 1
1175 curNameLev1 = Trim$(!NameLev1 & "")
1176 curNameLev2 = Trim$(!NameLev2 & "")
1177 curNameLev3 = Trim$(!NameLev3 & "")
1178 curNameLev4 = Trim$(!NameLev4 & "")
1179 curNameLev5 = Trim$(!NameLev5 & "")
'1179 curNameLev6 = Trim$(!NameLev6 & "")
1200 curRecIdList = mTreeTagDelimiter & CStr(!AttachmentID & "") &
mTreeTagDelimiter & CStr(!CollateralManagerID & "") & mTreeTagDelimiter &
CStr(!DealID & "") & mTreeTagDelimiter & CStr(!TrancheID & "") &
mTreeTagDelimiter & CStr(!UnderwriterID & "")
' -------------------------------------
' Deal record
1210 If curNameLev1 <> prvNameLev1 Then
1211 prvNameLev1 = curNameLev1
1212 myLev1Count = myLev1Count + 1
1213 DoEvents
1214 curNodeKeyLev1 = gNodeType_DealRec & !DealID
1215 curNodeTagLev1 = gNodeType_DealRec & curRecIdList
' NB: We are having trouble when we load too much into the top node's text.
' The tree winds up scrolled to the right just enough to hide the plus
and minus
' signs of the topmost nodes.
'1216 curNodeText = curNameLev1
1216 curNodeText = DealNode_TextCreate(curNameLev1,
!ClosingDate_Deal, !CollateralTypeShort, !CollateralManagerName,
!SizeCurrent_Deal, !SizeCurrentDate_Deal, !SizeOriginal_Deal, !StatusName_Deal,
!UnderwriterName)
On Error Resume Next
Set curNode = theTree.Nodes.Add(, , curNodeKeyLev1,
curNodeText)
'xxx curNode.Sorted = False
curErr = Err
On Error GoTo DealTreeLoad_ByDeal_err
1218 curNode.Tag = curNodeTagLev1
1219 curNode.Expanded = theExpandAllSwitch
1220 myNodeCount = myNodeCount + 1
1221 prvNameLev2 = "" 'Neccessary to
handle theoretical situations where the same deal name appears in different
consecutive tables
1222 prvNameLev3 = ""
1223 prvNameLev4 = ""
1224 prvNameLev5 = ""
'1224 prvNameLev6 = ""
1229 End If
' -------------------------------------
' Tranche Header
1230 If ((curNameLev2 said:
1231 prvNameLev2 = curNameLev2
1232 If Len(curNameLev2 & "") > 0 Then
1233 curNodeKeyLev2 = gNodeType_TrancheHeader & curRecIdList
1234 curNodeTagLev2 = gNodeType_TrancheHeader & curRecIdList
1235 curNodeText = curNameLev2
1236 Set curNode = theTree.Nodes.Add(curNodeKeyLev1, tvwChild,
curNodeKeyLev2, curNodeText)
1237 curNode.Tag = curNodeTagLev2
'xxx 1238 curNode.Sorted = False
1239 curNode.Expanded = theExpandAllSwitch
1240 myNodeCount = myNodeCount + 1
1241 End If
1242 prvNameLev3 = ""
1243 prvNameLev4 = ""
1244 prvNameLev5 = ""
'1249 prvNameLev6 = ""
1299 End If
' -------------------------------------
' Attachment Header
1300 If ((curNameLev3 <> prvNameLev3) And (Val(!AttachmentCount &
"") > 0)) Then
1301 prvNameLev3 = curNameLev3
1302 If Len(curNameLev3 & "") > 0 Then
1303 curNodeKeyLev3 = gNodeType_AttachmentHeader &
curRecIdList
1304 curNodeTagLev3 = gNodeType_AttachmentHeader &
curRecIdList
1305 curNodeText = curNameLev3
1306 Set curNode = theTree.Nodes.Add(curNodeKeyLev1, tvwChild,
curNodeKeyLev3, curNodeText)
1307 curNode.Tag = curNodeKeyLev3
'xxx 1308 curNode.Sorted = False
1309 curNode.Expanded = theExpandAllSwitch
1310 myNodeCount = myNodeCount + 1
1311 End If
1312 prvNameLev4 = ""
1313 prvNameLev5 = ""
'1319 prvNameLev6 = ""
1399 End If
' -------------------------------------
' Tranche Record
1400 If ((curNameLev4 <> prvNameLev4) And (Len(curNameLev4 & "") >
0)) Then
1401 prvNameLev4 = curNameLev4
1402 If Len(curNameLev4 & "") > 0 Then
1403 curNodeKeyLev4 = gNodeType_TrancheRec & !TrancheID
1404 curNodeTagLev4 = gNodeType_TrancheRec & curRecIdList
1405 curNodeText = curNameLev4
' On Error Resume Next
1406 Set curNode = theTree.Nodes.Add(curNodeKeyLev2, tvwChild,
curNodeKeyLev4, curNodeText)
' curErr = Err
' On Error GoTo DealTreeLoad_ByDeal_err
'
' If curErr = 0 Then
1407 curNode.Tag = curNodeTagLev4
1408 curNode.Expanded = theExpandAllSwitch
'1409 Else
'1410 Set myDebugNode = theTree.Nodes(curNodeKeyLev4)
'1411 BugAlert True, "Tranch node insert failed for key '"
& curNodeKeyLev4 & "'." & vbCrLf & vbCrLf & "There is already a node with
text='" & myDebugNode.Text & "'. It's parent is '" & myDebugNode.Parent & "'."
'1412 End If
1413 myNodeCount = myNodeCount + 1
1414 End If
1415 prvNameLev5 = ""
'1413 prvNameLev6 = ""
1419 End If
' -------------------------------------
' Attachment Record
1500 If curNameLev5 <> prvNameLev5 Then
1501 prvNameLev5 = curNameLev5
1502 If Len(curNameLev5 & "") > 0 Then
1503 curNodeKeyLev5 = gNodeType_AttachmentRec & !AttachmentID
1504 curNodeTagLev5 = gNodeType_AttachmentRec & curRecIdList
1509 curNodeText = curNameLev5
On Error Resume Next
Set curNode = theTree.Nodes.Add(curNodeKeyLev3, tvwChild,
curNodeKeyLev5, curNodeText)
Select Case Err
Case 0
On Error GoTo DealTreeLoad_ByDeal_err
1510 myNodeCount = myNodeCount + 1
1519 curNode.Tag = curNodeTagLev5
Case mGotDupeKey
On Error GoTo DealTreeLoad_ByDeal_err
1520 myNodeCount = myNodeCount + 1 'Just
increment the count. Because of the nature of the input query, we expect
duplicate attachments and just ignore them
Case Else
On Error GoTo DealTreeLoad_ByDeal_err
1530 BugAlert True, "Line 1505"
End Select
'xxx curNode.Sorted = False
curNode.Expanded = theExpandAllSwitch
On Error GoTo DealTreeLoad_ByDeal_err
1590 End If
'1512 prvNameLev6 = ""
1599 End If
' -------------------------------------
' (NOT USED
'1600 If curNameLev6 <> prvNameLev6 Then
'1601 prvNameLev6 = curNameLev6
'1602 If Len(curNameLev6 & "") > 0 Then
'1603 curNodeKeyLev6 = mTreeTagDelimiter & CStr(!DealID) &
mTreeTagDelimiter & "6"
'1604 curNodeTagLev6 = mTreeTagDelimiter & CStr(!DealID) &
mTreeTagDelimiter & "6"
'1605 curNodeText = curNameLev6
'1606 Set curNode = theTree.Nodes.Add(curNodeKeyLev5,
tvwChild, curNodeKeyLev6, curNodeText)
'1607 curNode.Tag = curNodeTagLev6
'1609 curNode.Expanded = theExpandAllSwitch
'1610 myNodeCount = myNodeCount + 1
'1611 End If
'1619 End If
'1900 curNode.Expanded = False
1911 If myNodeCount > 1000 Then
1912 myInputEstimate = (myNodeCount / myRecsLoaded) *
myInputCount
1913 If myInputEstimate > mNodeLimit Then
1914 MsgBox "The TreeView control cannot handle more than " &
Format$(mNodeLimit, "#,##0") & " nodes." & vbCrLf & vbCrLf & "At the rate we're
going, the currend selection will create " & Format$(myInputEstimate, "#,##0") &
"." & vbCrLf & vbCrLf & "Change your selection criteria and try again.",
vbExclamation, "Too Many Items - We're Not Going To Make It"
1915 Exit Do
1916 End If
1919 End If
1920 If myNodeCount > mNodeLimit - 6 Then
1921 MsgBox "The TreeView control cannot handle more than " &
Format$(mNodeLimit, "#,##0") & " nodes." & vbCrLf & vbCrLf & "Your selection has
already created " & Format$(myNodeCount, "#,##0") & " nodes - and the end is not
in sight." & vbCrLf & vbCrLf & "Change your selection criteria and try again.",
vbExclamation, "Too Many Items - Won't Fit"
1922 Exit Do
1929 End If
1930 myRecsLoaded = myRecsLoaded + 1
1931 .MoveNext
1932 SysCmd acSysCmdUpdateMeter, myRecsLoaded
1939 Loop
1940 End If
1941 SysCmd acSysCmdRemoveMeter
1949 End With
1950 With theTree.Nodes(1)
1951 .EnsureVisible
1952 .Selected = True
'1953 .Expanded = True
1959 End With
1960 Set thePrvRootNode = theTree.Nodes(1)
1961 With theTree
1962 .Font = "Courier New"
1969 End With
1994 DealTreeLoad_ByDeal = myLev1Count
1995 End If
1996 With DoCmd
1997 .Echo True
1998 .Hourglass False
1999 End With
DealTreeLoad_ByDeal_xit:
DebugStackPop
On Error Resume Next
Set curNode = Nothing
Set myQuery = Nothing
inputRS.Close
Set inputRS = Nothing
Set thisDB = Nothing
Exit Function
DealTreeLoad_ByDeal_err:
BugAlert True, "RecID='" & curRecID & ", ItemCount=" & Format$(itemCount, "0")
& "', curNodeKeyLev1='" & curNodeKeyLev1 & "', curNameLev1='" & curNameLev1 &
"', curNodeKeyLev2='" & curNodeKeyLev2 & "', curNameLev2='" & curNameLev2 & "',
curNodeKeyLev3='" & curNodeKeyLev3 & "', curNameLev3='" & curNameLev3 & "',
curNodeKeyLev4='" & curNodeKeyLev4 & "', curNameLev4='" & curNameLev4 & "',
curNodeKeyLev5='" & curNodeKeyLev5 & "', curNameLev5='" & curNameLev5 & "',
curNodeKeyLev6='" & curNodeKeyLev6 & ", curNameLev6='" & curNameLev6 & "',
DealID='" & Format$(curDealID, "0") & ", Query used to build work table='" &
myQuery.Name & ", ."
Resume DealTreeLoad_ByDeal_xit
End Function
==========================================
