How do I create a custom right-click menu?

[Seth Schrock]

In looking online I have come up with the following code.

Public Sub CreateMenu()
On Error GoTo Error_Handler
 
Dim cmdBar As CommandBarControl
 
On Error Resume Next
CommandBars("MyMenu").Delete
On Error GoTo Error_Handler
 
With CommandBars.Add(Name:="MyMenu", Position:=msoBarPopup)
    Set cmdBar = .Controls.Add(Type:=msoControlButton)
    cmdBar.Caption = "Add Database"
    cmdBar.OnAction = MenuAddDatabase
 
    Set cmdBar = .Controls.Add(Type:=msoControlButton)
    cmdBar.Caption = "View Roles"
    cmdBar.OnAction = MenuViewRoles
 
    Set cmdBar = .Controls.Add(Type:=msoControlButton)
    cmdBar.Caption = "Delete Database"
    cmdBar.OnAction = MenuDeleteDatabase
 
End With
 
Exit_Procedure:
 
    Exit Sub
 
Error_Handler:
    Call ErrorMessage(Err.Number, Err.Description, "modUtilities: CreateMenu")
    'TSCs_ReportUnexpectedError "CreateMenu", "modUtilities", "Custom info"
    Resume Exit_Procedure
    Resume
 
End Sub

Each of the functions in the cmdBar.OnAction commands just produce message boxes to let me know that the menu works. In my form's Mouse_Up event, I have the following code.

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo Error_Handler
 
If Button = acRightButton Then
    CommandBars("MyMenu").ShowPopup
    DoCmd.CancelEvent
End If
 
Exit_Procedure:
 
    Exit Sub
 
Error_Handler:
    Call ErrorMessage(Err.Number, Err.Description, "Form_sfrmEmployeeDatabases: Form_MouseUp")
    'TSCs_ReportUnexpectedError "Form_MouseUp", "Form_sfrmEmployeeDatabases", "Custom info"
    Resume Exit_Procedure
    Resume
 
 
End Sub

When I right click, the three message boxes appear one after the other before the menu even appears. When I click OK out of the last one the menu then appears. However, clicking the buttons doesn't produce the message boxes. I also can't have all the functions running before I make a selection as one of the function will turn into deleting the selected record.

I'm not sure what to do to get it to run my functions when I click the buttons and not before the menu appears.

[ADezii]

The following shortened Code will work as intended. Do you forget to place Parentheses around the Function Names in CreateMenu()?

Public Sub CreateMenu()
On Error GoTo Err_Procedure
On Error Resume Next
Dim cmbCtl As CommandBarControl
 
On Error GoTo 0
CommandBars("MyMenu").Delete
 
With CommandBars.Add(Name:="MyMenu", Position:=msoBarPopup)
 
Set cmbCtl = .Controls.Add(Type:=msoControlButton)
    cmbCtl.Caption = "View Rules"
    cmbCtl.OnAction = "MenuViewRoles"
End With
 
Exit_Procedure:
  Exit Sub
 
Err_Procedure:
  MsgBox Err.Description, vbExclamation, "Error in CreateMenu()"
    Resume Exit_Procedure
End Sub

[Seth Schrock]

Did you mean double quotes instead of parenthesis around the function names? I did try having double quotes around the function names, but they still didn't run in my code. When I get to work tomorrow, I'll give yours a try.

Just curious... On one website, I read that the menu only needed created once. Do I just run CreateMenu once (like maybe in the database opens) or do I need to call it every time I right click?

[Seth Schrock]

I solved it. I had the called functions set as private functions. Switching them to public functions fixed it. I also enclosed the function names in double quotes.

I remember reading that it had to be public functions, but I guess it went in one ear and out the other. Or would that be in one eye and out the other. Oh well, at least I solved it. thanks for your help ADezii.

[ADezii]

Anytime, Seth. The pleasure was all mine.