View Info Of Custom Menu

Question

In Access 2003, there was a custom menu created. How can I use VBA to view the details of the menu?

I.E. get a print out of what each option does? (the name, & query it runs) If the custom menu has an option to "Run Daily" and what that does is runs query titled qry_dly

Then I would ideally like to see the VBA output like so Run Daily --> qry_dly

Answer 1

This might need some tweaking, depending on the structure of the menu. but once you get a handle of how this works, you should be able to make changes to it if needed.

First, you need to find out the name of the Custom menu. if you know that already, then skip this step. Else grab the name(s) returned from this:

 Dim x As Integer
 For x = 1 To CommandBars.Count
    If CommandBars(x).BuiltIn = False Then
      Debug.Print x, CommandBars(x).Name, CommandBars(x).BuiltIn
   End If
 Next x

Then, pass the name of the Custom Menu to this procedure. like i said, depending on the way the menu is setup, this may or may not return everything in it, that is where you may need to customize it:

Private Sub ReadMenuControls(ByVal strCmdBar As String)

On Error GoTo errhandler

Dim x, y As Integer

Dim SubMenu As Object

 With CommandBars(strCmdBar)
  Debug.Print "Control Count Main: ", .Controls.Count

      For x = 1 To .Controls.Count
            With .Controls(x)
            Debug.Print x & " <== " & .Caption & " ==>"
                    If .Type = 1 Then 'Command Button

                         Debug.Print "Button", x, .Caption, .Type, .ID, .FaceId, .Style, .onaction

                    Else 'If .Type = 10 Then  'Menu

                        Set SubMenu = CommandBars(strCmdBar).Controls(x)

                        For y = 1 To SubMenu.Controls.Count
                              With .Controls(y)
                                 Debug.Print "  * Button", y, .Caption, .Type, .ID, .FaceId, .Style, .onaction
                              End With
                        Next
                   End If
            End With
      Next

 End With

Exit Sub

errhandler:
 If Err.Number <> 438 Then
  Debug.Print "ReadMenuControls", Err.Number, Err.description
 End If
 Resume Next
End Sub