Sure could.
The open event for the report simply calls the tvwWP_Fill function, which
does the real work:
Private Sub Report_Open(Cancel As Integer)
tvwWP_Fill
End Sub
The fill function given here is specific to my data, which is contained in
three tables, tblPhase, tblCA and tblWP. Each Phase can have multiple CAs,
and eac CA can have multiple WPs. The Phase table can be used directly to
fill the top level nodes, but the lower level nodes require queries to
obtain the actual string data used in the next higher level node to set the
child relationship. The SQL for the CA query is:
SELECT tblCA.CAID, tblPhase.PhaseID, tblPhase.PhaseName, tblCA.CAName,
tblCA.Expanded, tblCA.SortOrder
FROM tblPhase INNER JOIN tblCA ON tblPhase.PhaseID = tblCA.PhaseID
ORDER BY tblCA.SortOrder;
and the SQL for the WP query is:
SELECT tblWP.WPID, tblWP.WPName, tblCA.CAName, tblWP.Expanded
FROM tblCA INNER JOIN tblWP ON tblCA.CAID = tblWP.CAID
ORDER BY tblWP.SortOrder;
Given this date structure, the fill function is:
Function tvwWP_Fill()
'Created by Rob Parker 16-08-2004
'Based on code by Helen Feddema Access Archon #103
'
'Fills the ActiveX Treeview Control 'tvwWP'
On Error GoTo ErrorHandler
Dim strMessage As String
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim intVBMsg As Integer
Dim strQuery1 As String
Dim strQuery2 As String
Dim strQuery3 As String
Dim nod As Object
Dim strNode1Text As String
Dim strNode2Text As String
Dim strNode3Text As String
Dim strVisibleText As String
Set dbs = CurrentDb()
strQuery1 = "tblPhase"
strQuery2 = "qryCA"
strQuery3 = "qryWP"
With Me![tvwWP]
'Clear previous values
.Nodes.Clear
'Fill Level 1
Set rst = dbs.OpenRecordset(strQuery1, dbOpenForwardOnly)
'Add a node object for each record in the "qryPhase" table/query.
'The Key argument concatenates the level number and the LastNameFirst
'field of the Level 1 query, to create a unique key value for the
node.
'The Text argument is the text displayed as a Level 1 node in the
'TreeView control
Do Until rst.EOF
strNode1Text = StrConv("Level1" & rst![PhaseName], vbLowerCase)
Set nod = .Nodes.Add(Key:=strNode1Text, Text:=rst![PhaseName])
'Save the PhaseID to retrieve for use in form
nod.Tag = rst![PhaseID]
nod.Expanded = True
rst.MoveNext
Loop
rst.Close
'Fill Level 2
Set rst = dbs.OpenRecordset(strQuery2, dbOpenForwardOnly)
'Add a node object for each record in the "qryCA" table/query.
'The value of the Relative argument matches the Key argument value
'for the Level 1 node this Level 2 node belongs to.
'The Relationship argument takes a named constant, tvwChild,
'indicating that the Level 2 node becomes a child node of the
'Level 1 node named in the Relative argument.
'The Key argument concatenates the level number and the Title
'field of the Level 2 query, to create a unique key value for the
node.
'The Text argument is the text displayed as a Level 2 node in the
'TreeView control
Do Until rst.EOF
strNode1Text = StrConv("Level1" & rst![PhaseName], vbLowerCase)
strNode2Text = StrConv("Level2" & rst![CAName], vbLowerCase)
strVisibleText = rst!CAName
Set nod = .Nodes.Add(relative:=strNode1Text, _
relationship:=tvwChild, _
Key:=strNode2Text, _
Text:=strVisibleText)
'Save the CAID to retrieve for use in form
nod.Tag = rst![CAID]
nod.Expanded = True
rst.MoveNext
Loop
rst.Close
'Fill Level 3
Set rst = dbs.OpenRecordset(strQuery3, dbOpenForwardOnly)
'Add a node object for each record in the "qryWP" table/query.
'The value of the Relative argument matches the Key argument value
'for the Level 2 node this Level 3 node belongs to.
'The Relationship argument takes a named constant, tvwChild,
'indicating that the Level 3 node becomes a child node of the
'Level 2 node named in the Relative argument.
'The Key argument concatenates the level number and the Title
'field of the Level 3 query, to create a unique key value for the
node.
'The Text argument is the text displayed as a Level 3 node in the
'TreeView control
Do Until rst.EOF
strNode2Text = StrConv("Level2" & rst![CAName], vbLowerCase)
strNode3Text = StrConv("Level3" & rst![WPName], vbLowerCase)
strVisibleText = rst![WPName]
Set nod = .Nodes.Add(relative:=strNode2Text, _
relationship:=tvwChild, _
Key:=strNode3Text, _
Text:=strVisibleText)
'Save the WPID to retrieve for use in form
nod.Tag = rst![WPID]
nod.Expanded = True
rst.MoveNext
Loop
rst.Close
End With
dbs.Close
' MsgBox "TreeView filled ..."
DoEvents
ErrorHandlerExit:
Exit Function
ErrorHandler:
Select Case Err.Number
Case 35601
'Element not found
strMessage = vbNewLine & "Possible Causes: You selected a
table/query" _
& " for a child level which does not correspond to a value" _
& " from its parent level."
intVBMsg = MsgBox(Error$ & strMessage, vbOKOnly + _
vbExclamation, "Run-time Error: " & Err.Number)
Case 35602
'Key is not unique in collection
strMessage = vbNewLine & "Possible Causes: You selected a
non-unique" _
& " field to link levels."
intVBMsg = MsgBox(Error$ & strMessage, vbOKOnly + _
vbExclamation, "Run-time Error: " & Err.Number)
Case Else
intVBMsg = MsgBox(Error$ & "@@", vbOKOnly + _
vbExclamation, "Run-time Error: " & Err.Number)
End Select
Resume ErrorHandlerExit
End Function
Again, HTH,
Rob
