Module: TreeView in Category ActiveX Controls : Common Controls from Total Visual SourceBook

' Example of modTreeView
' This example assumes Access as the host language rather than a VBA program

' To try this example, do the following:
' 1. Create a new form
' 2. Add a TreeView control named 'tvwTest' and set the following property
'       HideSelection      False
' 3. Add a TreeView control named 'tvwCopy'
' 4. Add an ImageList control named 'iml'
' 5. Add any 4 icons to the 'iml' image list
' 6. Associate the 'iml' image list with both 'tvwTest' and 'tvwCopy'
' 7. Add the following command buttons
'       'cmdLoadArray'
'       'cmdLoadSample'
'       'cmdCollapse'
'       'cmdExpand'
'       'cmdTest'
'       'cmdLoadRS'
'       'cmdLoadRSTabular'
'       'cmdLoadRSHierarchy'
'       'cmdCopy'
' 8. Add a label named 'lblTreeViewData'
' 9. Paste all the code from this example to the new form's module.

' This example assumes that the sample files are located in the folder named by the following constant.
Private Const mcstrSamplePath As String = "C:\TVSBSamp"
Private Const mcstrConnect As String = "Provider=Microsoft.Jet.OLEDB.4.0;" & vbCrLf & "Data Source=" & mcstrSamplePath & "\sample.mdb"
Private mdbSample As DAO.Database

Private Sub cmdCopy_Click()
  CopyTreeView tvwTest.Object, tvwCopy.Object
End Sub

Private Sub Form_Load()
  cmdLoadArray.Caption = "Load Array"
  cmdLoadSample.Caption = "Load Sample"
  cmdCollapse.Caption = "Collapse"
  cmdExpand.Caption = "Expand"
  cmdTest.Caption = "Test"
  cmdLoadRS.Caption = "Load Recordset"
  cmdLoadRSTabular.Caption = "Load Tabular RS"
  cmdLoadRSHierarchy.Caption = "Load Hierarchy"
  cmdCopy.Caption = "Copy Tree"
  lblTreeViewData.Height = 990

  Call LoadSampleData
  Set mdbSample = DBEngine(0).OpenDatabase(mcstrSamplePath & "\sample.mdb")

End Sub

Private Sub cmdCollapse_Click()
  ' Sample of CollapseAllTreeViewNodes
  CollapseAllTreeViewNodes tvwTest.Object
End Sub

Private Sub cmdExpand_Click()
  ' Example of ExpandAllTreeViewNodes
  ExpandAllTreeViewNodes tvwTest.Object
End Sub

Private Sub cmdLoadArray_Click()
  Call LoadFromArray
End Sub

Private Sub cmdLoadRS_Click()
  Call LoadSingleRecordset
  Call LoadSingleADORecordset
End Sub

Private Sub cmdLoadRSHierarchy_Click()
  Call LoadRecordsetHierarchy
End Sub

Private Sub cmdLoadRSTabular_Click()
  Call LoadRecordsetTabular
  Call LoadADORecordsetTabular
End Sub

Private Sub cmdLoadSample_Click()
  Call LoadSampleData
End Sub

Private Sub cmdTest_Click()
  Dim nod As node

  ' Example of FindTextTreeView
  Set nod = FindTextTreeView(tvwTest.Object, "Brad", True)

  If nod Is Nothing Then
    MsgBox "'Brad' Not found"
  Else
    Set tvwTest.selectedItem = nod
  End If

  ' Example of FindTagTreeView
  Set nod = FindTagTreeView(tvwTest.Object, "Mal", False)

  If nod Is Nothing Then
    MsgBox "'Mal' Not found"
  Else
    Set tvwTest.selectedItem = nod
  End If
End Sub

Private Sub LoadFromArray()
  ' Example of ArrayToTreeView

  Dim astrNames() As String

  ReDim astrNames(1 To 10)

  astrNames(1) = "Larry"
  astrNames(2) = "Orel"
  astrNames(3) = "Nancy"
  astrNames(4) = "Matthew"
  astrNames(5) = "Rochelle"
  astrNames(6) = "Quinn"
  astrNames(7) = "Randy"
  astrNames(8) = "Paul"
  astrNames(9) = "Ulaf"
  astrNames(10) = "Timothy"

  tvwTest.Nodes.Clear

  ArrayToTreeView tvwTest.Object, astrNames

End Sub

Private Sub LoadSampleData()
  Dim nodRoot As node
  Dim nodAlpha As node
  Dim nodName As node
  Dim nodPhone As node

  tvwTest.Nodes.Clear

  Set nodRoot = tvwTest.Nodes.Add(, , "PB", "Phone Book", 1)

  Set nodAlpha = tvwTest.Nodes.Add(nodRoot.Index, tvwChild, "A", "A", 2)
  Set nodName = tvwTest.Nodes.Add(nodAlpha.Index, tvwChild, "A1", "Al", 3)
  nodName.Tag = "Johnson"
  Set nodPhone = tvwTest.Nodes.Add(nodName.Index, tvwChild, "P1", "Day - 555-1212", 4)
  Set nodPhone = tvwTest.Nodes.Add(nodName.Index, tvwChild, "P2", "Night - 555-1213", 4)

  Set nodName = tvwTest.Nodes.Add(nodAlpha.Index, tvwChild, "A2", "Anne", 3)
  nodName.Tag = "Smith"
  Set nodPhone = tvwTest.Nodes.Add(nodName.Index, tvwChild, "P3", "Day - 555-1214", 4)
  Set nodPhone = tvwTest.Nodes.Add(nodName.Index, tvwChild, "P4", "Night - 555-1215", 4)

  Set nodName = tvwTest.Nodes.Add(nodAlpha.Index, tvwChild, "A3", "Arden", 3)
  nodName.Tag = "Brooks"
  Set nodPhone = tvwTest.Nodes.Add(nodName.Index, tvwChild, "P5", "Day - 555-1216", 4)
  Set nodPhone = tvwTest.Nodes.Add(nodName.Index, tvwChild, "P6", "Night - 555-1217", 4)

  Set nodName = tvwTest.Nodes.Add(nodAlpha.Index, tvwChild, "A4", "Atley", 3)
  nodName.Tag = "Wilson"
  Set nodPhone = tvwTest.Nodes.Add(nodName.Index, tvwChild, "P7", "Day - 555-1218", 4)
  Set nodPhone = tvwTest.Nodes.Add(nodName.Index, tvwChild, "P8", "Night - 555-1219", 4)

  Set nodAlpha = tvwTest.Nodes.Add(nodRoot.Index, tvwChild, "B", "B", 2)
  Set nodName = tvwTest.Nodes.Add(nodAlpha.Index, tvwChild, "B1", "Bob", 3)
  nodName.Tag = "Jones"
  Set nodPhone = tvwTest.Nodes.Add(nodName.Index, tvwChild, "P9", "Day - 555-1220", 4)
  Set nodPhone = tvwTest.Nodes.Add(nodName.Index, tvwChild, "P10", "Night - 555-1221", 4)

  Set nodName = tvwTest.Nodes.Add(nodAlpha.Index, tvwChild, "B2", "Brad", 3)
  nodName.Tag = "Buckley"
  Set nodPhone = tvwTest.Nodes.Add(nodName.Index, tvwChild, "P11", "Day - 555-1222", 4)
  Set nodPhone = tvwTest.Nodes.Add(nodName.Index, tvwChild, "P12", "Night - 555-1223", 4)

  Set nodName = tvwTest.Nodes.Add(nodAlpha.Index, tvwChild, "B3", "Brenda", 3)
  nodName.Tag = "Clemens"
  Set nodPhone = tvwTest.Nodes.Add(nodName.Index, tvwChild, "P13", "Day - 555-1224", 4)
  Set nodPhone = tvwTest.Nodes.Add(nodName.Index, tvwChild, "P14", "Night - 555-1225", 4)

  Set nodName = tvwTest.Nodes.Add(nodAlpha.Index, tvwChild, "B4", "Buster", 3)
  nodName.Tag = "Keaton"
  Set nodPhone = tvwTest.Nodes.Add(nodName.Index, tvwChild, "P15", "Day - 555-1226", 4)
  Set nodPhone = tvwTest.Nodes.Add(nodName.Index, tvwChild, "P16", "Night - 555-1227", 4)

  Set nodAlpha = tvwTest.Nodes.Add(nodRoot.Index, tvwChild, "C", "C", 2)

  Set nodName = tvwTest.Nodes.Add(nodAlpha.Index, tvwChild, "C1", "Carl", 3)
  nodName.Tag = "Malone"

  Set nodName = tvwTest.Nodes.Add(nodAlpha.Index, tvwChild, "C2", "Cathy", 3)
  nodName.Tag = "Delio"

  Set nodName = tvwTest.Nodes.Add(nodAlpha.Index, tvwChild, "C3", "Cindy", 3)
  nodName.Tag = "Ergnon"

  Set nodName = tvwTest.Nodes.Add(nodAlpha.Index, tvwChild, "C4", "Corben", 3)
  nodName.Tag = "Enrico"

End Sub

Private Sub LoadSingleRecordset()
  ' Example of RecordsetToTreeView

  Dim rstProducts As DAO.Recordset
  Dim strSQL As String

  strSQL = "SELECT * FROM Products ORDER BY ProductName"

  Set rstProducts = mdbSample.OpenRecordset(strSQL)

  tvwTest.Nodes.Clear

  RecordSetToTreeViewDAO rstProducts, tvwTest.Object, "ProductName", "ProductID", "CategoryID"

End Sub

Private Sub LoadSingleADORecordset()
  ' Example of ADORecordsetToTreeView

  Dim cnn As New ADODB.Connection
  Dim rstCustomers As New ADODB.Recordset
  Dim strSQL As String

  strSQL = "SELECT * FROM Customers ORDER BY CompanyName"

  cnn.Open mcstrConnect
  rstCustomers.Open strSQL, cnn, adOpenKeyset, adLockOptimistic

  tvwCopy.Nodes.Clear

  RecordSetToTreeViewADO rstCustomers, tvwCopy.Object, "CompanyName", "CustomerID", "ContactName"

End Sub

Private Sub LoadRecordsetHierarchy()
  ' Alternate example for RecordsetToTreeview
  ' This example loads one recordset in the first pass, and the loads a related recordset in the second pass, getting a reference
  ' to the parent node to use for the details in the second recordset

  Dim rstSuppliers As DAO.Recordset
  Dim rstProducts As DAO.Recordset
  Dim nod As node

  tvwTest.Nodes.Clear

  Set rstSuppliers = mdbSample.OpenRecordset("SELECT SupplierID, CompanyName, ContactName FROM Suppliers ORDER BY CompanyName")

  ' Load recordset with first-level information from Suppliers
  RecordSetToTreeViewDAO rstSuppliers, tvwTest.Object, "CompanyName", "SupplierID", "ContactName", , " S"

  rstSuppliers.MoveFirst

  ' For each row in the Suppliers table, create a recordset consistin of the corresponding records in the Products table; Locate the
  ' SupplierID node in the treeview, and add the data from the Product table under this node:
  Do Until rstSuppliers.EOF

    ' Get a reference to the parent node for this Supplier; we know the key value for the node consists of the SupplierID value
    ' and an " S" suffix:
    Set nod = tvwTest.Nodes(rstSuppliers!SupplierID & " S")

    Set rstProducts = mdbSample.OpenRecordset("SELECT ProductID, ProductName FROM Products WHERE SupplierID = " & rstSuppliers!SupplierID)

    ' Load the related data for the current product
    RecordSetToTreeViewDAO rstProducts, tvwTest.Object, "ProductName", "ProductID", , nod, " P"

    rstSuppliers.MoveNext

  Loop

  ExpandAllTreeViewNodes tvwTest.Object

End Sub

Private Sub LoadADORecordsetTabular()
  ' Example of TabularADORecordsetToTreeView
  ' This example uses the first character of the ProductName field as the "parent" column for the other Product entries, which
  ' are then shown underneath this alpha character.

  Dim rstProducts As ADODB.Recordset
  Dim strSQL As String

  tvwCopy.Nodes.Clear

  strSQL = "SELECT Left(Products.ProductName,1) as ProdInit, Products.* FROM Products ORDER BY Products.ProductName"

  Set rstProducts = New ADODB.Recordset
  rstProducts.Open strSQL, mcstrConnect

  TabularRecordsetToTreeViewADO rstProducts, tvwCopy.Object, "ProdInit", "ProductName"

  ExpandAllTreeViewNodes tvwCopy.Object

End Sub

Private Sub LoadRecordsetTabular()
  ' Example of TabularRecordsetToTreeView
  ' This example creates a join between Categories and Products.
  ' Each Category is a major node of the treeview, and each product is a sub-node within that category

  Dim rstCatProd As DAO.Recordset
  Dim strSQL As String

  tvwTest.Nodes.Clear

  strSQL = "SELECT Categories.*, Products.* FROM Categories " & _
           "INNER JOIN Products ON Categories.CategoryID = Products.CategoryID " & _
           "ORDER BY Categories.CategoryName, Products.ProductName; "

  Set rstCatProd = mdbSample.OpenRecordset(strSQL)

  ' This example shows all optional arguments supplied, including key and tag fields for the GroupBy and Detail values, as well as the
  ' value to use on numeric keyfields to make them storable as Node keys. Notice that since the CategoryID field occurs in both
  ' the Products and Categories table in the join, it is necessary to qualify the field name with the table name

  TabularRecordsetToTreeViewDAO rstCatProd, tvwTest.Object, "CategoryName", "ProductName", "Categories.CategoryID", "ProductID", "Description", "SupplierID", " C", " P"

  ExpandAllTreeViewNodes tvwTest.Object

End Sub

Private Sub tvwCopy_NodeClick(ByVal node As Object)
  lblTreeViewData.Caption = _
    "Key: " & node.Key & vbCrLf & _
    "Tag: " & node.Tag & vbCrLf & _
    "Lvl: " & GetNodeLevel(node)
End Sub

Private Sub tvwTest_NodeClick(ByVal node As Object)
  lblTreeViewData.Caption = _
    "Key: " & node.Key & vbCrLf & _
    "Tag: " & node.Tag & vbCrLf & _
    "Lvl: " & GetNodeLevel(node)
End Sub

The source code in Total Visual Sourcebook includes modules and classes for Microsoft Access, Visual Basic 6 (VB6), and Visual Basic for Applications (VBA) developers. Easily add this professionally written, tested, and documented royalty-free code into your applications to simplify your application development efforts.

Total Visual SourceBook is written for the needs of a developer using a source code library covering the many challenges you face. Countless developers over the years have told us they learned some or much of their development skills and tricks from our code. You can too!

Additional Resources

• List of All Modules in Total Visual SourceBook
• List of All Code Categories in Total Visual SourceBook
• Sample Module Code from Total Visual SourceBook (Example of Date, Time and Age Calculations)