Open Current Record from Right-Click CommandBar Menu

Question

I'm using this code to create a right-click menu for my Datasheet form (Access 2007). This code runs in the datasheet subform on the Open event:

Dim sMenuName As String
sMenuName = "DatasheetRightClickMenu"

On Error Resume Next
CommandBars(sMenuName).Delete
If Err.Number <> 0 Then Err.Clear
On Error GoTo 0

Dim cmb As Office.CommandBar
Dim cmbItem

Set cmb = CommandBars.Add(sMenuName, _
           msoBarPopup, False, False)


Set cmbItem = cmb.Controls.Add(msoControlButton, , , , True)
With cmbItem
    .Caption = "Open"
    .OnAction = "=OpenDetails()"
End With

Me.ShortcutMenu = True
Me.ShortcutMenuBar = sMenuName

I can't figure out how to pass the current record's ID to the OpenDetails function. I'd be happy if I could just figure out how to pass in the form or recordset variable/reference but I can't seem to figure out how to do that either.

What's the trick to passing "real-time" arguments or parameters from a right-click menu to a custom function? Do you have to build the right-click menu when the user clicks? Or is there a better way of doing this?

Edit1:
Here's what I have got working so far:

Private Sub Form_Current()
    Call CreateRightClickMenu
End Sub

Private Sub CreateRightClickMenu()
    Dim sMenuName As String
    sMenuName = Me.Name & "RClickMenu"

    On Error Resume Next
    CommandBars(sMenuName).Delete
    If Err.Number <> 0 Then Err.Clear
    On Error GoTo 0

    Dim cmb As Office.CommandBar
    Dim cmbItem

    Set cmb = CommandBars.Add(sMenuName, _
               msoBarPopup, False, False)


    Dim s1() As String, s2 As String
    If Nz(Me.txtitemdesc, "") <> "" Then
        s2 = Me.txtitemdesc & " "
        s2 = Replace(s2, ",", " ")
        s1 = Split(s2, " ")
        s2 = s1(0)
    End If

    Set cmbItem = cmb.Controls.Add(msoControlButton, , , , True)
    With cmbItem
        .Caption = "Open " & Replace(Me.txtitemdesc, "&", "&&")
        .Parameter = Me!ItemID
        .OnAction = "OpenFromDatasheetRightClick"
    End With

    Set cmbItem = cmb.Controls.Add(msoControlButton, , , , True)
    With cmbItem
        .FaceId = 640
        .Caption = "Filter = '" & s2 & "'"
        .Parameter = s2
        .OnAction = "FilterAllItemsDatasheet"
    End With

    If Me.FilterOn = True And Me.Filter <> "" Then
        Set cmbItem = cmb.Controls.Add(msoControlButton, , , , True)
        With cmbItem
            .Caption = "Clear Filter"
            .Parameter = ""
            .OnAction = "FilterAllItemsDatasheet"
        End With
    End If

    Me.ShortcutMenu = True
    Me.ShortcutMenuBar = sMenuName
End Sub

It seems that my callback functions have to be in a a public module, not a form module.

Public Sub FilterAllItemsDatasheet()
    Dim cbar As CommandBarControl
    Set cbar = CommandBars.ActionControl
    If cbar Is Nothing Then
        Debug.Print "CBar is nothing"
        Exit Sub
    End If
    Dim s1
    s1 = cbar.Parameter
    If s1 = "" Then
        Call Forms("frmAllItemsDatasheet").ClearFilter
    Else
        Forms("frmAllItemsDatasheet").cboSearch = s1
        Call Forms("frmAllItemsDatasheet").UpdateSubform
    End If
End Sub


Public Sub OpenFromDatasheetRightClick()
    Dim cbar As CommandBarControl
    Set cbar = CommandBars.ActionControl
    If cbar Is Nothing Then
        Debug.Print "CBar is nothing"
        Exit Sub
    End If
    Dim s1
    s1 = cbar.Parameter
    Call OpenItemDetailForm(s1)
    Forms("frmAllItemsDatasheet").SetFocus
End Sub

score 0 · Answer 1 · answered May 22 '12 at 07:49

0

How about:

Set cmbItem = cmb.Controls.Add(msoControlButton, , , , True)
With cmbItem
    .Caption = "Open"
    .OnAction = "=OpenDetails([ID])"
End With

''Function
Function OpenDetails(intID)
    MsgBox intID
    ''This would also work
    MsgBox Screen.ActiveForm.ID
End Function

Don't forget to close and reopen the form when testing :)

answered May 22 '12 at 07:49

Fionnuala

90,370
7
114
152

I get an error: The object doesn't contain the Automation object 'ID'. I tried several different fields and they all had the same problem. – HK1 May 22 '12 at 11:22
I tested using your code from above, a datasheet form and the Open event. I use 2010 but it is pretty much the same as 2007 for menus. I wonder is it worth trying with a scratch database and a new form? That error sometimes occurs when you have been working on the same form for sometime and it has become corrupt. Does `Screen.Activeform.[somesuitablefield]` return anything? – Fionnuala May 22 '12 at 11:53
Where did you put your OpenDetails function? Form module or code module? – HK1 May 22 '12 at 12:15
I didn't test the Screen.ActiveForm thing. I consider that to be sort of a last resort as it seems to me it could be unpredictable. Can you recommend it as a stable, predictable method to use? – HK1 May 22 '12 at 12:16
Alber Kallal uses Screen.ActiveForm : http://stackoverflow.com/questions/1462876/msaccess-2003-vba-for-passing-a-value-from-one-form-to-another – Fionnuala May 22 '12 at 12:22
Thanks for that link. Albert's examples there will likely have some far reaching results on how I develop in the future. I've been struggling with passing data between forms and calling functions on other forms for a long time already. – HK1 May 22 '12 at 12:29

Open Current Record from Right-Click CommandBar Menu

1 Answers1

Linked