Here is a piece of code I wrote for doing just this. I am sure you can figure out how to mod it to give you the desired data since this one is based off of some DB tables. Just copy this into a mod and start looking it through.
Public Function ItemTree()
Dim rstTrMain As New ADODB.Recordset, strMain As String
Dim rstTrSub As New ADODB.Recordset, strSub As String
Dim adoCmd As New ADODB.Command, I As Integer
Dim strLoopIt As String, recLoopIt As record
Set objItemsTree = frmMainGUI.trItemsTree
strMain = "SELECT Divisions.Division, trim(Divisions.Description) as Description From Divisions"
Set adoCmd = New ADODB.Command
With adoCmd
.ActiveConnection = strMC2PJ
.CommandText = strMain
rstTrMain.CursorLocation = adUseClient
rstTrMain.Open adoCmd
End With
strSub = "SELECT Round(([MinValue]/1000)-(([Minvalue] Mod 1000)/1000),0) AS Div, fix(MajorItemCodeGroup.MinValue/100) as Minval, MajorItemCodeGroup.ItemCodeGroup, MajorItemCodeGroup.MinValue, MajorItemCodeGroup.Description AS ItemDescription, trim(Divisions.Description) AS DivDescription FROM MajorItemCodeGroup LEFT JOIN Divisions ON Round((MajorItemCodeGroup.[MinValue]/1000)-((MajorItemCodeGroup.[Minvalue] Mod 1000)/1000),0) = Divisions.Division ORDER BY MajorItemCodeGroup.[MinValue];"
With adoCmd
.ActiveConnection = strMC2PJ
.CommandText = strSub
rstTrSub.CursorLocation = adUseClient
rstTrSub.Open adoCmd
End With
Do Until rstTrMain.EOF
If rstTrMain!Description <> "** Undefined **" Then
Set nodCurr = objItemsTree.Nodes.Add(, , "a" & rstTrMain!Division, "Division " & rstTrMain!Division & " - " & rstTrMain!Description!)
AddChildrenItems nodCurr, rstTrSub, strSub, objItemsTree
End If
rstTrMain.MoveNext
Loop
End Function
Sub AddChildrenCS(nodParent As Node, rst As Recordset, strSub As String, objTree As Object)
'Reference to nodParent, rst, strSub, objTree from optCSTree or optItems
Dim nodCurrent As Node
Dim strText As String, bk
Dim rstTier2 As New ADODB.Recordset
Dim adoTier2 As New ADODB.Command
Set adoTier2 = New ADODB.Command
With adoTier2
.ActiveConnection = strMC2KB
.CommandText = strSub
rstTier2.CursorLocation = adUseClient
rstTier2.Open adoTier2
End With
'Find the first item for the category for this node.
rst.MoveFirst
rst.Find "[MenuID] ='" & Mid(nodParent.Key, 2) & "'"
'Build the list of items for this category.
Do Until rst.EOF
'Add as a child node to the tree.
Set nodCurrent = objTree.Nodes.Add(nodParent, tvwChild, "as" & rst!ObjID, rst!CSNum & " - " & rst!CSName) 'rst!Image, rst!ImageExpanded
rst.Find "[MenuID]='" & Mid(nodParent.Key, 2) & "'", 1, adSearchForward
Loop
ExitAddChildrenCS:
Exit Sub
ErrAddChildrenCS:
MsgBox "Can't add child: " & Err.Description, vbCritical, _
"AddChildren(nodParent As Node) Error:"
Resume ExitAddChildrenCS
End Sub
Sub AddChildrenItems(nodParent As Node, rst As Recordset, strSub As String, objTree As Object)
'Reference to nodParent, rst, strSub, objTree from optCSTree or optItems
Dim nodCurrent As Node
Dim strText As String * 9, bk
Dim rstUPCItems As New ADODB.Recordset
Dim adoUPCItems As New ADODB.Command
Dim strFormMin As String * 9, strFormCodeGrp As String * 9
Dim I As Integer
I = 1
Set adoUPCItems = New ADODB.Command
With adoUPCItems
.ActiveConnection = strMC2PJ
.CommandText = strSub
rstUPCItems.CursorLocation = adUseClient
rstUPCItems.Open adoUPCItems
End With
'Find the first item for the category for this node.
rst.MoveFirst
rst.Find "[Div] ='" & Mid(nodParent.Key, 2) & "'"
'Build the list of items for this category.
Do Until rst.EOF
'Extract and format the number within the Fields MinValue and
'ItemGroupCode to follow DB convention.
strFormMin = Format$(FormatNumber(rst!MinValue, 3), "00000.000")
strFormCodeGrp = Format$(FormatNumber(rst!ItemCodeGroup, 3), "00000.000")
On Error GoTo AIHere
'Add as a child node to the tree.
Set nodCurrent = objTree.Nodes.Add(nodParent, tvwChild, "ai" & rst!MinVal, strFormMin & " - " & strFormCodeGrp & " - " & rst!ItemDescription) 'rst!Image, rst!ImageExpanded
AISKey:
On Error GoTo 0
'Save your place in the recordset.
bk = rst.Bookmark
'Add any Items for the current branch of tree
AddChildrenTier3 nodCurrent, rst, objTree
'Return to your place in the recordset and continue to search.
rst.Bookmark = bk
rst.Find "[DIV]='" & Mid(nodParent.Key, 2) & "'", 1, adSearchForward
Loop
ExitAddChildrenItems:
Exit Sub
ErrAddChildrenItems:
MsgBox "Can't add child: " & Err.Description, vbCritical, _
"AddChildren(nodParent As Node) Error:"
Resume ExitAddChildrenItems
AIHere:
If Err.Number <> 0 Then ' = True Then
Set nodCurrent = objTree.Nodes.Add(nodParent, tvwChild, "ais" & rst!MinVal & "_" & I, strFormMin & " - " & strFormCodeGrp & " - " & rst!ItemDescription) 'rst!Image, rst!ImageExpanded
Err.Clear
I = I + 1
End If
Resume AISKey
End Sub
Message was edited by: Dragnsbld
