2

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

右クリック時にこれを機能させるには、何を変更する必要がありますか?

4

2 に答える 2

3

問題に対する決定的な答えはここにあります：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
于 2013-02-27T17:09:01.633 に答える
1

Outlook 2003 をインストールしていませんが、Outlook 2010 では、同じように右クリック メニューをいじることができません。したがって、これはコンパイルされ、うまくいけば、必要なものに近いものになります。

コードを記述する前に、非表示のアイテムを表示して、いくつかのオブジェクトの Intellisense を取得する必要があると思います。2010 では、ActiveExporer オブジェクトと ActiveInspector オブジェクト (Outlook の 2 種類のビュー (たとえば、すべての電子メールを表示する、または 1 つの電子メールを表示する)) が非表示になります。それらを再表示するには、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 を右クリックして、必要なメニューの名前を取得します。最後のボタンのダッシュの前の部分になります。「フーバー」としましょう。

その後、これを行うことができるはずです：

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 で何度もやったことがあります (アドインを 2 つも書きました)。

于 2013-02-26T03:42:13.570 に答える