-
Feb 16th, 2018, 02:16 PM
#1
Thread Starter
Member
Key is not unique in collection
Hello all,
I am not very familiar with VB, I haven't used it in years, but I have an issue with some code that is in a MS access file. It is giving me a "Key is not unique in collection error".
The code is below:
Code:
Option Compare Database
Option Explicit
' Clears all nodes on a treeview control
Sub ClearTreeView(tvwTree As TreeView)
On Error GoTo EH
tvwTree.Nodes.Clear
Exit Sub
EH:
MsgBox "Error " & Err.Number & ": " & Err.Description
End Sub
' Calls functions to clear and populate a treeview control
' Parameters:
' strForm Name of the form
' strTV TreeView control name
' strSourceName Name of the table or query containing the data used to populate the treeview
' strChildField ID field for the child records
' strParentField Parent ID Field
' strTextField Field containing text that will be used as node labels
'
Sub FillTreeView(tvwTree As Object, strSourceName As String, strChildField As String, strParentField As String, strTextField As String)
Dim strSQL As String
Dim rs As DAO.Recordset
On Error GoTo EH
' Open the recordset using table and fields specified in Sub parameters
strSQL = "SELECT " & strChildField & ", " & strParentField & ", " & strTextField & " FROM " & strSourceName
Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
' Clear any existing data out of the treeview
ClearTreeView tvwTree
' Call recursive function to fill in treeview
AddTreeData tvwTree, rs, strChildField, strParentField, strTextField
' Close the recordset
rs.Close
Set rs = Nothing
Exit Sub
EH:
MsgBox "Error " & Err.Number & ": " & Err.Description
End Sub
' Recursive function to populate a treeview control
' Parameters:
' strFormName Name of the form
' strTreeViewName TreeView control name
' rs Recordset containing the data used to populate the treeview
' strChildField ID field for the child records
' strParentField Parent ID Field
' strTextField Field containing text that will be used as node labels
' varParentID Optional parameter that only gets passed for recursive calls to this function. Specifies the ID of the current record to be used as a
' ParentID when searching the recordset for "grand-children", etc.
Sub AddTreeData(objTV As TreeView, rs As DAO.Recordset, strChildField As String, strParentField As String, strTextField As String, Optional varParentID As Variant)
Dim nodChild As Node
Dim nodParent As Node
Dim strLabel As String
Dim strNodeID As String
Dim strCriteria As String
Dim strBookmark As String
On Error GoTo EH
' Test for a circular reference
If rs(strChildField) = rs(strParentField) Then GoTo EH_CircularReference
' If the optional parameter is missing, then this is the first(non-recursive) call to this function.
' Set the critieria to look for a parent id of 0.
If IsMissing(varParentID) Then
strCriteria = strParentField & " = 0 "
Else
' Otherwise, extract the childID portion of the node ID, which was passed as an optional parameter.
strCriteria = strParentField & " = " & Mid(varParentID, InStr(1, varParentID, "C") + 1)
' Define the parent node
Set nodParent = objTV.Nodes("node" & varParentID)
End If
' Look for records having the specified "parent"
rs.FindFirst strCriteria
Do Until rs.NoMatch
' Read node caption from the text field
strLabel = rs(strTextField)
' Create a new node ID in the format ParentID &"C" & ChildID (eg: 4C12)
strNodeID = "node" & rs(strParentField) & "C" & rs(strChildField)
' If optional parameter is missing (first call to this function)...
If Not IsMissing(varParentID) Then
'add new node to the next higher node for this record
Set nodChild = objTV.Nodes.Add(nodParent, tvwChild, strNodeID, strLabel)
Else
' Otherwise, add new node to the top level of the tree
Set nodChild = objTV.Nodes.Add(, , strNodeID, strLabel)
End If
' Bookmark our place in the recordset so that we can resume the search from the same point after the recursive call to this function.
strBookmark = rs.Bookmark
' call this function recursively for "children"
AddTreeData objTV, rs, strChildField, strParentField, strTextField, rs(strParentField) & "C" & rs(strChildField)
' Return to bookmared place in the recordset
rs.Bookmark = strBookmark
' Find the next record having the same parentID
rs.FindNext strCriteria
Loop
Exit Sub
EH_CircularReference:
MsgBox "Exiting because of a circular reference in which a child record was determined to be it's own parent."
Exit Sub
EH:
MsgBox "Error " & Err.Number & ": " & Err.Description
End Sub
Any help is greatly appreciated
Thanks
Dave
Last edited by Shaggy Hiker; Feb 16th, 2018 at 03:45 PM.
Reason: Added CODE tags.
-
Feb 16th, 2018, 03:49 PM
#2
Re: Key is not unique in collection
Welcome to the forums. I edited your post to wrap the code in [CODE][/CODE] tags, which, as you can see, makes it somewhat more nicely formatted. You can do this by pressing the # button and pasting the code between the resulting tags. I also move the question to the Office Development forum, since it's a VBA question.
As a final point: Which line is the exception being thrown on? You may not know that right away, so you may need to comment out the On Error line so that it crashes at the point of the exception. There are other ways to find it, that just might be the easiest.
My usual boring signature: Nothing
-
Feb 16th, 2018, 04:15 PM
#3
Thread Starter
Member
Re: Key is not unique in collection
Shaggy Hiker,
Sorry I put it in the wrong section, as you know I am new to this forum, but hope to be a frequent visitor to learn this again. Thanks also for making it more readable.
Dave
-
Feb 16th, 2018, 04:43 PM
#4
Re: Key is not unique in collection
' Create a new node ID in the format ParentID &"C" & ChildID (eg: 4C12)
looks like the ID is getting duplicated
can you post a sample of the table data?
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
-
Feb 16th, 2018, 05:02 PM
#5
Thread Starter
Member
Re: Key is not unique in collection
Now I have another issue, I tried to comment out the On Error and run it and found I have another issue. I am running Windows 10 at home along with Office 2010, at work we are running Windows 7 and Office 2010. On my home computer (HP Laptop) I get a new error "There is no Object in this control" . This database is a file that I found on the internet that I thought would work as a starting point for an application at work. I have attached the database so hopefully someone can help me out with it. If you open the form "frmExpandAssembly" , you'll may see the "There is no Object in this control" issue. If you get by that issue then choose KABRSA-12 in the "Pick Assembly" dropdown, enter 1 for the quantity to build, then hit "Expand Parts List", you should get the original error of "Key is not unique in collection error". I cannot get to that point here at home because of the "There is no Object in this control" issue.
Thanks
Dave
Daves Tree View 2-16-18.zip
-
Feb 16th, 2018, 06:10 PM
#6
Thread Starter
Member
Re: Key is not unique in collection
I should also add that this was a .mdb file which I converted to an .accdb file
-
Feb 16th, 2018, 11:08 PM
#7
Re: Key is not unique in collection
i work with access databases quite often, but i do not have access installed, the code as posted in the OP, would run in VBA with a treeview on a userform, but as i do not have access to the calling procedure, i do not know what the paramerters are for calling fill treeview including which of the 4 table is being passed
i can open a recordset using select * from tblpartmain, but i doubt the fields in that are being passed to the treeview
also as i am not opening the database in access, i am unable to help with the error you are getting, possibly related to the registration of the treeview control
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|