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

Answer 2

I no longer have Outlook 2003 installed and Outlook 2010 doesn't let you mess with right-click menus the same way. So this compiles and is, hopefully close to what you need to do.

Before writing any code, you'll want to show hidden items, I think, to get the Intellisense for a couple of objects. In 2010 the ActiveExporer and ActiveInspector objects - which are the two types of view in Outlook, e.g., looking at all you email, or looking at a single email - are hidden. To unhide them, go into the Object Explorer by clicking F2 in the VBE, and right-click just about anywhere and check "Show Hidden Items".

So now you're ready to code:

First you need a way to determine the name of the right-click menu you are interested in. This tries to add a button to every menu, with the button's caption being the name and index of the menu. It resets the menu first, so as to not create more than one such button. The button should be at the bottom of the menu. The buttons are temporary, meaning they'll be gone the next time you open Outlook:

Sub GetCommandBarNames()
Dim cbar As Office.CommandBar
Dim cbarButton As Office.CommandBarButton

For Each cbar In ActiveInspector.CommandBars
    On Error Resume Next
    cbar.Reset
    Set cbarButton = cbar.Controls.Add(Type:=msoControlButton, temporary:=True)
    With cbarButton
        .Caption = cbar.Name
        .Style = msoButtonCaption
        .Visible = True
    End With
    On Error GoTo 0
Next cbar
For Each cbar In ActiveExplorer.CommandBars
    On Error Resume Next
    cbar.Reset
    Set cbarButton = cbar.Controls.Add(Type:=msoControlButton, temporary:=True)
    With cbarButton
        .Caption = cbar.Name & "-" & cbar.Index
        .Style = msoButtonCaption
        .Visible = True
    End With
    On Error GoTo 0
Next cbar
End Sub

After running this, right-click in Outlook and get the name of the menu you want. It will be the part before the dash on the last button. Let's say it's "foobar".

You should then be able to do this:

Sub AddButton()
Dim cbar As Office.CommandBar
Dim cbarButton As Office.CommandBarButton

Set cbar = ActiveExplorer.CommandBars("foobar")    'or maybe it's ActiveInspector
Set cbarButton = cbar.Controls.Add(Type:=msoControlButton, temporary:=True)
With cbarButton
    .Caption = "&Submenu item"
    .OnAction = "macro"
    .Style = msoButtonCaption
    'etc.
End With
'do the next button
Set cbarButton = cbar.Controls.Add(Type:=msoControlButton, temporary:=True)
'...
End Sub

Like I say, I'm doing this a bit blind, but I've done it many times in Excel (I even wrote two addins), so if this doesn't work, I should be able to get you there.