Here is all the code I have in the switchboard form including the subform.
'.
'.=========================================================================
'.Copyright : ©Bryan Carbonnell 2002 All rights reserved.
'.=========================================================================
' DO NOT DELETE THE COMMENTS ABOVE. All other comments in this module
' may be deleted from production code, but lines above must remain.
'--------------------------------------------------------------------------
'.Written By : Bryan Carbonnell
'.Date Created : 29-Oct-2002
'.Rev. History :
'.Comments :
'.-------------------------------------------------------------------------
'.
' ADDITIONAL NOTES:
'
'*+ Module constant declaration
'Change the following Constant's value to change the
' title of the Switchbaord
Private Const cstrSWITCHBOARDTITLE As String = "Switchboard"
'Change this constant if you change the table name that holds the
' Switchboard items
Private Const mstrTableName As String = "twzSwitchboardItems"
Private Const cstrModuleName As String = "Form_frmSwitchboard"
Private Enum SBCommands
sbeOpenSwitchboard = 1
sbeOpenForminAddMode = 2
sbeOpenForminEditMode = 3
sbePreviewReport = 4
sbeCustomizeSwitchboard = 5
sbeExitApplication = 6
sbeRunMacro = 7
sbeRunCode = 8
sbeOpenDataAccessPage = 9
End Enum
'*- Module constants declaration
'*+ Module variables declaration
Private WithEvents tvw As TreeView
'*- Module variables declarations
Option Compare Database
Option Explicit
Private Sub Form_Open(Cancel As Integer)
DoCmd.Maximize
'--------------------------------------------------------------------------
'.Purpose : To Handle the openeing of the Switchboard Form
'.Author : Bryan Carbonnell
'.Date : 29-Nov-2002
'.Calls :
'.Revised : 29-Nov-2002 - Original
'--------------------------------------------------------------------------
Const cstrProcName As String = "Form_Open"
'Set a reference to the Treeview control
Set tvw = tvwSwitchboard.Object
'Restore Form
DoCmd.Restore
'Fill Treeview with switchboard items
fFillTreeView
End Sub
Private Sub fFillTreeView()
'--------------------------------------------------------------------------
'.Purpose : To (re)Fill the treeview with top level nodes
'.Author : Bryan Carbonnell
'.Date : 29-Nov-2002
'.Called by : Form_Open, tvw_NodeClick
'.Calls : fFillChildren
'.Revised : 29-Nov-2002 - Original
'--------------------------------------------------------------------------
Const cstrProcName As String = "fFillTreeView"
Dim strSQL As String
Dim rst As DAO.Recordset
Dim nd As Node
'Clear Treeview nodes
tvw.Nodes.Clear
'Build SQL to get Enabled Root Level Items
strSQL = "Select * FROM " & mstrTableName & _
" WHERE SwitchboardID=1" & _
" AND ItemNumber<>0" & _
" AND Enabled=True" & _
" ORDER BY ItemNumber"
'Open the Recordset
Set rst = CurrentDb().OpenRecordset(strSQL)
'Loop Through and build the nodes
Do While Not (rst.EOF)
'Create the Node
Set nd = tvw.Nodes.Add(, , , rst!ItemText)
'Build Node Tag
nd.Tag = "Command=" & rst!Command & ";Argument=" & rst!Argument
'nd.Tag = fBuildTag(rst)
'Check to see if we have an Open Switchboard Item
If rst!Command = sbeOpenSwitchboard Then
'This is an Open SB so we need to fill the children
sFillChildren nd
End If
'Move to next record
rst.MoveNext
Loop
'Close and release
rst.Close
Set rst = Nothing
End Sub
Private Sub sFillChildren(nd As Node)
'--------------------------------------------------------------------------
'.Purpose : To Fill any children nodes
'.Author : Bryan Carbonnell
'.Date : 29-Nov-2002
'.Called by : fFillTreeView, fFillChildren (recursive)
'.Calls :
'.Inputs : nd - Node - Parent node of these children
'.Revised : 29-Nov-2002 - Original
'--------------------------------------------------------------------------
Const cstrProcName As String = "sFillChildren"
Dim aryPairs() As String
Dim arySplit() As String
Dim strSQL As String
Dim lngArgument As Integer
Dim lngLoop As Long
Dim rst As DAO.Recordset
Dim ndNew As Node
'Split tag into pairs
aryPairs = Split(nd.Tag, ";")
'Loop through split to get SwitchboardID that this node
' opens, which is the Argument
For lngLoop = LBound(aryPairs) To UBound(aryPairs)
'Now split each
arySplit = Split(aryPairs(lngLoop), "=")
If arySplit(0) = "Argument" Then
'Get the Argument Value, which is the SB to Open
lngArgument = Val(arySplit(1))
Exit For
End If
Next
'Build SQL to select all the items in the Switchboard
' but not the 0 record, which is just info about the
' switchboard
strSQL = "SELECT * FROM " & mstrTableName & _
" WHERE SwitchboardID=" & lngArgument & _
" AND ItemNumber<>0" & _
" AND Enabled=True"
Set rst = CurrentDb.OpenRecordset(strSQL)
'Loop through reordset to add new tags
Do While Not (rst.EOF)
'Add New Node
Set ndNew = tvw.Nodes.Add(nd, tvwChild, , rst!ItemText)
'Build Node Tag
ndNew.Tag = "Command=" & rst!Command & ";Argument=" & rst!Argument
'Check and see if we just added an Open Switchboard
If rst!Command = sbeOpenSwitchboard Then
'We did, so add children
sFillChildren ndNew
End If
'Move to next record
rst.MoveNext
Loop
End Sub
Private Sub tvw_NodeClick(ByVal Node As MSComctlLib.Node)
'--------------------------------------------------------------------------
'.Purpose : To handle the user clicking a node, which means that node
'. holds the command we are going to run
'.Author : Bryan Carbonnell
'.Date : 29-Nov-2002
'.Calls :
'.Inputs :
'.Output :
'.Revised : 29-Nov-2002 - Original
'--------------------------------------------------------------------------
Const cstrProcName As String = "tvw_NodeClick"
Dim aryPairs() As String
Dim aryElements() As String
Dim varArgument As Variant
Dim lngLoop As Long
Dim sbcCommand As SBCommands
On Error GoTo tvw_NodeClick_Error
'Split Node tag into pairs
aryPairs = Split(Node.Tag, ";")
'Loop through pairs to get elements
For lngLoop = LBound(aryPairs) To UBound(aryPairs)
aryElements = Split(aryPairs(lngLoop), "=")
'See which pair it is
Select Case aryElements(0)
Case "Command"
'This is the command that will be run
sbcCommand = aryElements(1)
Case "Argument"
'This is the argument of the command
varArgument = aryElements(1)
End Select
Next
Dim nod As Node
Set nod = Node
Me.mysubformcontrol.SourceObject = nod.Key
'Now Run the Command
Select Case sbcCommand
Case sbeOpenSwitchboard
'Expand or Collapse Switchboard Node
Node.Expanded = Not Node.Expanded
Case sbeOpenForminAddMode
'Open form in Add Mode
DoCmd.OpenForm varArgument, , , , acFormAdd
Case sbeOpenForminEditMode
'Open Form in Edit Mode
DoCmd.OpenForm varArgument, , , , acFormEdit
Case sbePreviewReport
'Preview report
DoCmd.OpenReport varArgument, acViewPreview
Case sbeCustomizeSwitchboard
'Run Treeview Switchboard Wizard
Application.Run "SBWizard.tvwsbWizard_Entry"
'Refill treeview
fFillTreeView
Case sbeExitApplication
'Exit Application
DoCmd.Quit
Case sbeRunMacro
'Run Macro
DoCmd.RunMacro varArgument
Case sbeRunCode
'Run Code
Application.Run varArgument
Case sbeOpenDataAccessPage
'Open DAP
DoCmd.OpenDataAccessPage varArgument
End Select
'Exit here
tvw_NodeClick_Exit:
Exit Sub
'Error Handler
tvw_NodeClick_Error:
Select Case Err.Number
Case 2501, 2102
'2501 - Report opening was cancelled
'2102 - Unable to Open Form
' MsgBox "The command you selected was cancelled", _
vbOKOnly + vbExclamation, "Command Cancelled"
Case 2517 ' Switchboard Wizard not installed
MsgBox " This command is unavailable at the moment.", _
vbInformation + vbOKOnly, "Error running command"
Case Else
MsgBox "Error executing Switchboard command " & _
vbCrLf & "Error #:" & Err.Number & _
vbCrLf & "Description: " & Err.Description, _
vbExclamation + vbOKOnly, "Error executing Command"
End Select
Resume Next
'For Debugging
Resume
End Sub
Hope this helps. Look forward to your reply.
