MS ACCESS: Create a dynamic menu with SwitchBoard table

The following example demonstrates how to create a dynamic menu based on SwitchBoard table contente.

Step 1. Create a custom toolbar

1. On the Tools menu, click Customize.
2. Click the Toolbars tab.
3. Click New.
4. In the Toolbar name box, type the name you want (ex. MyCustMenuBar), and then click OK.
5. Click the properties button.
6. Set Type to Menu Bar

Step 2. Class Modules clsMenu

Option Compare Database
Option Explicit
Const cTOOLBAR = "MyCustMenuBar"
Const cMACRO = "=MenuHandle () "
' Constants for the commands that can be executed. 
 Public Const conCmdGotoSwitchboard = 1
 Public Const conCmdOpenFormAdd = 2
 Public Const conCmdOpenFormBrowse = 3
 Public Const conCmdOpenReport = 4
 Public Const conCmdCustomizeSwitchboard = 5
 Public Const conCmdExitApplication = 6
 Public Const conCmdRunMacro = 7
 Public Const conCmdRunCode = 8
 Public Const conCustomizeMenu = 9

Public Function FillSubMenu(SwitchboardID As Long, menuSelected As Object) As Boolean
    Dim rst As Recordset
    Dim intOption As Integer
    Dim ctl As CommandBarControl
    'Clear menu   
   For Each ctl In menuSelected.Controls
        Call ctl.Delete
    Next

    ' If there are no options for this Switchboard Page,
    ' display a message.  Otherwise, fill the page with the items.   
    Set rst = Me.GetMenuOptions(SwitchboardID)
   
    If (rst.EOF) Then
        MsgBox ("There are no items for this switchboard page")
    Else
        While (Not (rst.EOF))
            Dim newMenu As CommandBarControl
           
            If (SwitchboardID = 1) Then
                    Set newMenu = menuSelected.Controls.Add(Type:=msoControlPopup)
            Else
                Select Case rst!Command
                 Case conCmdGotoSwitchboard
                     Set newMenu = menuSelected.Controls.Add(Type:=msoControlPopup)
                 Case conCustomizeMenu
                     Set newMenu = menuSelected.Controls.Add(Type:=msoControlPopup)
                 Case conCmdRunCode
                    If (rst!Argument = "CreateSLTReportSubMenu") Then
                        Set newMenu = menuSelected.Controls.Add(Type:=msoControlPopup)
                    Else
                        Set newMenu = menuSelected.Controls.Add(Type:=msoControlButton, Temporary:=True)
                    End If
                 Case Else
                     Set newMenu = menuSelected.Controls.Add(Type:=msoControlButton, Temporary:=True)
                 End Select
            End If
            newMenu.Caption = rst![ItemText]
            newMenu.tag = Trim$(str$(SwitchboardID))
            newMenu.OnAction = cMACRO          
           rst.MoveNext
        Wend    End If
    ' Close the recordset and the database.   
rst.Close
End Function

Public Function GetMenuOptions(SwitchboardID As Long, Optional mnuGlobal) As Recordset
    Dim strSQL As String
    Dim fixedMenu As String
    If Not IsMissing(mnuGlobal) Then fixedMenu = " OR [SwitchboardID]=" & mnuGlobal
    ' Open the table of Switchboard Items, and find
    ' the first item for this Switchboard Page.   
    strSQL = "SELECT id, SwitchboardID,ItemNumber, ItemText ,command,Argument"
    strSQL = strSQL & " FROM [Switchboard Items]"
    strSQL = strSQL & " WHERE [ItemNumber] > 0 AND ([SwitchboardID]=" & SwitchboardID & fixedMenu & ")"
    strSQL = strSQL & " ORDER BY SwitchboardID,[ItemNumber];"
   
    Set GetMenuOptions = CurrentDb.OpenRecordset(strSQL)
End Function

Public Function HandleButtonClick(Optional switchmenu, Optional btnid, Optional stdMenu)
' This function is called when a button is clicked.
' intBtn indicates which button was clicked.
   
    Dim dbs As Database
    Dim rst As Recordset
   
    '*****************
    Dim intBtn As Integer
    Dim SwitchboardID As Integer
    Dim isStandardMnu As Boolean
    On Error GoTo HandleButtonClick_Err
   
    ' Le Tag dans le bouton contient le SwitchBoardID
    If IsMissing(switchmenu) Then
        SwitchboardID = CInt(Application.CommandBars.ActionControl.tag)
    Else
         SwitchboardID = switchmenu
    End If
   
    If IsMissing(btnid) Then
        intBtn = Application.CommandBars.ActionControl.Index
    Else
        intBtn = btnid
    End If
   
    ' If the standard menu clicked
    If IsMissing(stdMenu) Then
        isStandardMnu = False
    Else
        isStandardMnu = stdMenu
    End If
  
    ' Find the item in the Switchboard Items table
    ' that corresponds to the button that was clicked.
    Set dbs = CurrentDb()
   
    Set rst = dbs.OpenRecordset("Switchboard Items", dbOpenDynaset)
    rst.FindFirst "[SwitchboardID]=" & SwitchboardID & " AND [ItemNumber]=" & intBtn
   
    lastMenu = rst!ID  'Handle pressed menu id
  
    ' If no item matches, report the error and exit the function.
    If (rst.NoMatch) Then
        MsgBox "There was an error reading the Switchboard Items table."
        rst.Close
        dbs.Close
        Exit Function
    End If
   
    Select Case rst![Command]
       
        ' Go to another switchboard.
        Case conCmdGotoSwitchboard
            If isStandardMnu Then
                 Forms("Switchboard").Filter = "[ItemNumber] = 0 AND [SwitchboardID]=" & rst![Argument]
            Else
                Call Me.FillSubMenu(rst![Argument], Application.CommandBars.ActionControl)
            End If
               
        ' Open a form in Add mode.
        Case conCmdOpenFormAdd
            OpenForm rst![Argument], acNormal, , , acAdd, , -1
        ' Open a form.
        Case conCmdOpenFormBrowse
             OpenForm rst![Argument]
           
        ' Open a report.
        Case conCmdOpenReport
            DoCmd.OpenReport rst![Argument], acPreview
        Case conCmdExitApplication
            CloseCurrentDatabase
        ' open form with paramaters
        Case conCmdOpenFormWithPara
            OpenForm rst![Argument], acNormal, , , , , rst![parameters]
           
        Case conCmdOpenFormAddWthPara
            OpenForm rst![Argument], , , , acFormAdd, , rst![parameters]
        ' Run a macro.
        Case conCmdRunMacro
            DoCmd.RunMacro rst![Argument]
        ' Run code.
        Case conCmdRunCode
            If Nz(rst!parameters, "") = "" Then
                Application.Run rst![Argument]
            Else
                Application.Run rst![Argument], rst!parameters
            End If
        ' Customize Menu
        Case conCustomizeMenu, conRunCustomizeMenu
            Application.Run rst![Argument]
           
        ' Any other command is unrecognized.
        Case Else
         MsgBox "Unknown option."
   
    End Select
    ' Close the recordset and the database.
    rst.Close
    dbs.Close

HandleButtonClick_Exit:
    Exit Function
HandleButtonClick_Err:
    ' If the action was cancelled by the user for
    ' some reason, don't display an error message.
    ' Instead, resume on the next line.
    If (err = conErrDoCmdCancelled) Then
        Resume Next
    Else
        MsgBox ("There was an error executing the command.")
        Resume HandleButtonClick_Exit
    End If
   
End Function

Public Function InitializeMenu()
    Call FillSubMenu(1, Application.CommandBars(cTOOLBAR))
End Function

Step 3. Module MainModule

Public  oMenu As new clsMenu

Public Function MenuHandle() As Boolean
    Call oMenu.HandleButtonClick
    MenuHandle = True
End Function
Step 4. SwitchBoard Form

Add this line in Form_load module
oMenu.InitializeMenu