在Outlook 2003中创建一个右键快捷菜单(Create a right-click cont

我已经能够在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不会让你乱用鼠标右键单击菜单相同的方式。 所以这编译并是，希望接近你需要做什么。

编写任何代码之前，你要显示隐藏的项目，我想，让智能感知了几个对象。 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中（我甚至写了两个加载项），因此，如果这也不行，我应该能够让你有。

文章来源: Create a right-click context menu in Outlook 2003