Outlook 自定义菜单按钮

Posted 2023-02-16

【中文标题】Outlook 自定义菜单按钮

【英文标题】：Outlook custom menu buttons

【发布时间】：2016-03-30 06:26:12

【问题描述】：

我有 2 个菜单按钮，我想在帮助菜单后添加到 Outlook 菜单中。我编写了添加按钮的代码，但每次我重新打开 Outlook 时它只会再添加 2 个按钮，即使 2 个菜单按钮已经存在。欢迎任何帮助。

Function ToolBarExists(strName As String) As Boolean
Dim tlbar As commandBar
    For Each tlbar In ActiveExplorer.CommandBars
     If tlbar.Name = strName Then
        ToolBarExists = True
        Exit For
    End If
Next tlbar
End Function

Sub TBarExistsbutton1()
    If ToolBarExists("button1") Then
        If ActiveExplorer.CommandBars("button1").Visible = True Then
            ActiveExplorer.CommandBars("button1").Visible = False
        Else
            ActiveExplorer.CommandBars("button1").Visible = True
        End If
    Else
        Call a123
    End If

End Sub
Sub TBarExistsbutton2()
    If ToolBarExists("button2") Then
        If ActiveExplorer.CommandBars("button2").Visible = True Then
            ActiveExplorer.CommandBars("button2").Visible = False
        Else
            ActiveExplorer.CommandBars("button2").Visible = True
        End If
    Else
        Call a1234
    End If
    End Sub

Sub a123()
Dim outl As Object
Dim msg As Object
Set outl = CreateObject("Outlook.Application")
Dim objBar As Office.commandBar
Dim objButton As Office.commandBarButton
Set objBar = Application.ActiveWindow.CommandBars("Menu Bar")
Set objButton = objBar.Controls.Add(msoControlButton)
    With objButton
    .caption = "button1"
    .onAction = "macro1"
    .faceId = 487
    .Style = msoButtonIconAndCaption
End With
End Sub

Sub a1234()
Dim outl As Object
Dim msg As Object
Set outl = CreateObject("Outlook.Application")
Dim objBar As Office.commandBar
Dim objButton As Office.commandBarButton
Set objBar = Application.ActiveWindow.CommandBars("Menu Bar")
Set objButton = objBar.Controls.Add(msoControlButton)
With objButton
    .caption = "button2"
    .onAction = "macro2"
    .faceId = 487
    .Style = msoButtonIconAndCaption
End With
End Sub

【问题讨论】：

什么时候使用 Function ToolBarExists(strName As String) As Boolean？

嗨，该功能应该检查现有的工具栏，我有大约 10 个。它应该按工具栏的名称检查。

【参考方案1】：

在 Outlook 2010 中。如果 Visible 适合您，请以类似方式合并它。

Option Explicit

Sub TBarExistsbutton1()

    Dim cbControlCount As Long
    Dim button1Found As Boolean
    Dim j As Long

    If ToolBarExists("Menu Bar") Then

        cbControlCount = ActiveWindow.CommandBars("Menu Bar").Controls.count
        Debug.Print " There are " & cbControlCount & " controls in " & "Menu Bar"

        For j = 1 To cbControlCount
            Debug.Print ActiveWindow.CommandBars("Menu Bar").Controls(j).Caption
            If ActiveWindow.CommandBars("Menu Bar").Controls(j).Caption = "button1" Then
                button1Found = True
                Exit For
            End If
        Next j

        If button1Found = False Then a123

    Else
        Debug.Print "Menu Bar does not exist."
        a123

    End If

End Sub