Create a right-click context menu in Outlook 2003

Question

I'm already able to create a new menu in the top menubar of Outlook 2003 but would like to do the same when the user right-click on an email (but not anywhere else in the interface if possible).

Here is what I got:

Sub AddMenus()
    Dim cbMainMenuBar As CommandBar
    Dim cbcCustomMenu As CommandBarControl
    Dim cbcTest As CommandBarControl
    Dim iHelpMenu as Integer

    Set cbMainMenuBar = Application.ActiveExplorer.CommandBars.ActiveMenuBar
    iHelpMenu = cbMainMenuBar.Controls("&?").index

    Set cbcCustomMenu = cbMainMenuBar.Controls.Add(Type:=msoControlPopup, before:=iHelpMenu)
    cbcCustomMenu.caption = "Menu &Name"

    Set cbcTest = cbcCustomMenu.Controls.Add(Type:=msoControlPopup)
    cbcTest.caption = "&Test"

    With cbcTest.Controls.Add(Type:=msoControlButton)
                .caption = "&Submenu item"
                .OnAction = "macro"
    End With
    With cbcTest.Controls.Add(Type:=msoControlButton)
                .caption = "Another submenu item"
                .OnAction = "macro"
    End With
    With cbcCustomMenu.Controls.Add(Type:=msoControlButton)
                .caption = "About"
                .OnAction = "macro"
    End With
End Sub

What do I have to change to make this works when right-clicking?

Answer 1

The definitive answer to the problem can be found here: http://www.outlookcode.com/codedetail.aspx?id=314

Here is what I come with after removing some of the code/comments I didn't need:

Option Explicit

Private WithEvents ActiveExplorerCBars As CommandBars
Private WithEvents ContextButton As CommandBarButton     
Private IgnoreCommandbarsChanges As Boolean

Private Sub Application_Startup()
    Set ActiveExplorerCBars = ActiveExplorer.CommandBars
End Sub

Private Sub ActiveExplorerCBars_OnUpdate()
    Dim bar As CommandBar

    If IgnoreCommandbarsChanges Then Exit Sub

    On Error Resume Next
    Set bar = ActiveExplorerCBars.Item("Context Menu")
    On Error GoTo 0

    If Not bar Is Nothing Then
        AddContextButton bar
    End If
End Sub

Sub AddContextButton(ContextMenu As CommandBar)
    Dim b As CommandBarButton
    Dim subMenu As CommandBarControl
    Dim cbcCustomMenu As CommandBarControl, cbcLink As CommandBarControl

    Set ContextMenu = ActiveExplorerCBars.Item("Context Menu")

    'Unprotect context menu
    ChangingBar ContextMenu, Restore:=False

    'Menu
    Set cbcCustomMenu = ContextMenu.Controls.Add(Type:=msoControlPopup)
    cbcCustomMenu.caption = "&Menu"

    'Link in Menu
    Set cbcLink = cbcCustomMenu.Controls.Add(Type:=msoControlButton)
    cbcLink.caption = "Link 1"
    cbcLink.OnAction = "macro"

    'Reprotect context menu
    ChangingBar ContextMenu, Restore:=True
End Sub

'Called once to prepare for changes to the command bar, then again with
'Restore = true once changes are complete.
Private Sub ChangingBar(bar As CommandBar, Restore As Boolean)
  Static oldProtectFromCustomize, oldIgnore As Boolean

  If Restore Then
    'Restore the Ignore Changes flag
    IgnoreCommandbarsChanges = oldIgnore

    'Restore the protect-against-customization bit
    If oldProtectFromCustomize Then bar.Protection = bar.Protection And msoBarNoCustomize

  Else
    'Store the old Ignore Changes flag
    oldIgnore = IgnoreCommandbarsChanges
    IgnoreCommandbarsChanges = True

    'Store old protect-against-customization bit setting then clear
    'CAUTION: Be careful not to alter the property if there is no need,
    'as changing the Protection will cause any visible CommandBarPopup
    'to disappear unless it is the popup we are altering.
    oldProtectFromCustomize = bar.Protection And msoBarNoCustomize
    If oldProtectFromCustomize Then bar.Protection = bar.Protection And Not msoBarNoCustomize
  End If
End Sub