如何使用VBA添加到Outlook 2013的功能区和/或获取功能区按钮的名称?

时间:2015-01-06 23:19:43

标签: vba outlook outlook-vba outlook-2003

我在Google上为此问题找到的所有内容都指的是Excel或Word以及他们所说的内容对Outlook不起作用。

我需要做两件事:

  1. 使用Outlook 2013中的VBA向Outlook 2013功能区的“主页”选项卡上的自定义组添加按钮。
  2. 在单击每个按钮时运行的宏中,我希望能够告诉单击按钮的名称。
  3. 对于#1:我在网上找不到任何有用的信息。

    对于#2:我的想法是我希望有一个可变数量的按钮,如“Do 1”,“Do 2”,“Do 3”,......,“Do X”,每个按钮都会运行相同的宏/子和宏/子内我可以看到按钮的名称是什么,所以我知道该怎么做。否则我必须为每个按钮创建一个子/宏,我试图避免这种情况。

4 个答案:

答案 0 :(得分:3)

唯一可行的方法是开发加载项。 Outlook不允许使用VBA自定义UI。

您可能会发现Walkthrough: Creating a Custom Tab by Using the Ribbon Designer页面有用。

答案 1 :(得分:1)

我想我找到了它!

对于#1,请参阅: HOW TO: Manipulating Office Ribbon Bar only with VBA

对于#2,您需要在功能区定义XML文件中添加 onAction 子例程。

<mso:button id="MyButtonIdentifier1" label="MyMacroLabel" imageMso="HyperlinksVerify" onAction="NameOfMyMacro" visible="true"/>

NameOfMyMacro 的定义应如下所示:

Sub NameOfMyMacro(control As IRibbonControl)
    'here your logic
    Select Case control.Id
        Case "MyButtonIdentifier1"
           'call another subroutine ;)
        Case "MyButtonIdentifier2"
    End Select
End Sub

答案 2 :(得分:0)

有一种方法可以在ADODB.Stream

的帮助下将自定义功能区添加到Outlook 2013中

我在工作中使用这个解决方案多年了 - 但我也无法在家中应用它。

首先,我正在准备一个包含XML结构的文本文件:

Dim Stream As Object
Dim FSO As FileSystemObject
Dim tsZwischenspeicher As TextStream

Set Stream = CreateObject("ADODB.Stream")
Set FSO = CreateObject("Scripting.FileSystemObject")

strPfad = "C:\Users\" & (Environ("username")) & "\AppData\Local\Microsoft\Office\"
strSpeicherpfad = strPfad & "olkexplorer.officeUI"
strTempSpeicherpfad = strPfad & "olkexplorer.temp"

...

tsZwischenspeicher.WriteLine Anführungszeichen("<mso:customUI xmlns:x1='http://schemas.microsoft.com/office/2009/07/customui/macro' xmlns:mso='http://schemas.microsoft.com/office/2009/07/customui'>")
tsZwischenspeicher.WriteLine Anführungszeichen("<mso:ribbon>") & vbCrLf
tsZwischenspeicher.WriteLine Anführungszeichen("<mso:qat>")
tsZwischenspeicher.WriteLine Anführungszeichen("<mso:sharedControls>")
tsZwischenspeicher.WriteLine Anführungszeichen("<mso:control idQ='mso:FilePrint' visible='false'/>")

然后生成的XML文件可以通过ADODB.Stream转移到Outlook中:

'Eine neue Fußzeile erstellen
tsZwischenspeicher.WriteLine Anführungszeichen("</mso:tabs>")
tsZwischenspeicher.WriteLine Anführungszeichen("</mso:ribbon>")
tsZwischenspeicher.WriteLine Anführungszeichen("</mso:customUI>")

'Zwischengespeicherte Datei schließen
tsZwischenspeicher.Close

Stream.Open
Stream.Type = 2 'text
Stream.Charset = "utf-8"
Stream.LoadFromFile strTempSpeicherpfad
FSO.OpenTextFile(strSpeicherpfad, 2, True, True).Write Stream.ReadText
Stream.Close

必须重新启动Outlook并显示新功能区。

答案 3 :(得分:0)

在Outlook 2010中工作,14.0.7232.5000:

在ThisOutlookSession中:

Private WithEvents Button As Office.CommandBarButton

Private Sub Application_Startup()
  Dim oExplorer As Outlook.Explorer
  Set oExplorer = Application.ActiveExplorer
  ' Dynamically create button at  Outlook startup (no need for XML file)
  Set Button = CreateCommandBarButton(oExplorer.CommandBars)
end sub



Private Sub Button_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
  ' Code to be executed upon clicking the button.
  ' The name of the function MUST be "buttonname_Click", with "buttonname" 
  ' defined in Application_Startup().
  MsgBox "Click: " & Ctrl.Caption
End Sub



Private Function CreateCommandBarButton(oBars As Office.CommandBars) As Office.CommandBarButton
  On Error Resume Next
  Dim oMenu As Office.CommandBar
  Dim oBtn As Office.CommandBarButton
  Const BAR_NAME As String = "YourCommandBarName"
  Const CMD_NAME As String = "YourButtonName"

  Set oMenu = oBars(BAR_NAME)
  If oMenu Is Nothing Then
    Set oMenu = oBars.Add(BAR_NAME, msoBarTop, , True)
    Set oBtn = oMenu.Controls.Add(msoControlButton, , CMD_NAME, , True)
    oBtn.Caption = CMD_NAME
    oBtn.Tag = CMD_NAME

  Else
    Set oBtn = oMenu.FindControl(, , CMD_NAME)
    If oBtn Is Nothing Then
      Set oBtn = oMenu.Controls.Add(msoControlButton, , CMD_NAME, , True)
    End If
  End If

  oMenu.Visible = True
  Set CreateCommandBarButton = oBtn
End Function