vba - 在 Outlook 2003 中创建右键单击上下文菜单

Question

我已经能够在 Outlook 2003 的顶部菜单栏中创建一个新菜单，但希望在用户右键单击电子邮件时执行相同的操作(但如果可能，不要在界面中的其他任何位置单击)。

这是我得到的:

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

我需要更改什么才能使其在右键单击时起作用？

Answer 1

问题的明确答案可以在这里找到:http://www.outlookcode.com/codedetail.aspx?id=314

这是我删除一些不需要的代码/注释后得到的结果:

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