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

Answer 2

我不再安装Outlook 2003，并且Outlook 2010不会让您以相同的方式混淆右键单击菜单。因此，这可以编译并希望接近您需要做的事情。

在编写任何代码之前，我想要显示隐藏的项目，以获取几个对象的Intellisense。在2010年，隐藏了ActiveExporer和ActiveInspector对象 - 这两种对象是Outlook中的两种类型的视图，例如查看您发送的所有电子邮件或查看单个电子邮件。要取消隐藏它们，请通过单击VBE中的F2进入对象资源管理器，然后右键单击任意位置并选中“显示隐藏项目”。

所以现在你已准备好编码了：

首先，您需要一种方法来确定您感兴趣的右键单击菜单的名称。这会尝试为每个菜单添加一个按钮，按钮的标题是菜单的名称和索引。它首先重置菜单，以便不创建多个这样的按钮。该按钮应位于菜单的底部。这些按钮是临时的，这意味着它们将在您下次打开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

运行此操作后，右键单击Outlook并获取所需菜单的名称。它将是最后一个按钮上的破折号之前的部分。让我们说它是“foobar”。

然后你应该能够这样做：

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

就像我说的那样，我这样做有点失明，但我已经在Excel中做了很多次（我甚至写了两个插件），所以如果这不起作用，我应该能够让你到那里

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

2 个答案: