如何添加自定义 Outlook 按钮

问题描述 投票：0回答：1

我的 Outlook 功能区上有一个自定义按钮，可以发送 Webhook 请求。

我无法获取 VBA 脚本来添加按钮。
此外，如果预览的电子邮件不包含正则表达式模式，我希望禁用该按钮。

我正在使用 Outlook for Microsoft 365（版本 2305）。
我在 VBA 项目中启用了 Outlook 对象库和 VBScript 正则表达式引用。

主要VBA模块：

Option Explicit

Public matchedText As String
Public regexPattern As String

Private objExplorerEventHandler As ExplorerEventHandler
Private isButtonAdded As Boolean

Sub InitializeRibbon()
    MsgBox "InitializeRibbon started"
    regexPattern = "WORD\d{7}|WORD\d{7}"
    Set objExplorerEventHandler = New ExplorerEventHandler
    Set objExplorerEventHandler.Explorer = Outlook.Application.ActiveExplorer
    UpdateCustomButtonState ' Update the custom button state (enabled/disabled)
End Sub

Sub AddCustomButtonToRibbon()
    MsgBox "AddCustomButtonToRibbon started"
    Dim objItem As Object
    Set objItem = GetCurrentPreviewItem()

    If objItem Is Nothing Then
        Exit Sub
    End If

    ' Check if the previewed item is an email
    If TypeOf objItem Is Outlook.MailItem Then
        Dim emailContent As String
        emailContent = objItem.Body

        ' Use regular expression to find matches
        Dim regex As Object
        Set regex = CreateObject("VBScript.RegExp")
        With regex
            .Global = True
            .IgnoreCase = True
            .MultiLine = True
            .pattern = regexPattern
        End With

        Dim matches As Object
        Set matches = regex.Execute(emailContent)
        If matches.Count > 0 Then
            matchedText = matches(0).Value
        Else
            matchedText = "" ' Reset the matchedText if regex doesn't match
        End If
    End If

    UpdateCustomButtonState ' Update the custom button state (enabled/disabled)
End Sub

Sub CreateCustomButton()
    Dim ribbon As Office.IRibbonUI
    Set ribbon = objExplorerEventHandler.RibbonUI
    If Not ribbon Is Nothing Then
        ribbon.ExecuteMso "TabCustom" ' Activate the "Custom" tab
        ribbon.InvalidateControl "MyCustomButton" ' Invalidate the custom button
    End If
End Sub

Sub RemoveCustomButton()
    Dim ribbon As Office.IRibbonUI
    Set ribbon = objExplorerEventHandler.RibbonUI
    If Not ribbon Is Nothing Then
        ribbon.InvalidateControl "MyCustomButton" ' Invalidate the custom button
    End If
End Sub

Sub UpdateCustomButtonState()
    Dim ribbon As Office.IRibbonUI
    Set ribbon = objExplorerEventHandler.RibbonUI
    If Not ribbon Is Nothing Then
        ' Invalidate the custom button to trigger the GetButtonEnabled callback
        ribbon.InvalidateControl "MyCustomButton"
    End If
End Sub

Sub SendWebhook(control As IRibbonControl)
    Dim HttpReq As Object
    Dim URL As String
    Dim WebhookData As String
    
    URL = "https://webook.url"
    
    WebhookData = "{""ticket"":""matchedText"",""user"":""first.lastname""}"
    
    On Error Resume Next
    Set HttpReq = CreateObject("MSXML2.XMLHTTP")
    If HttpReq Is Nothing Then
        MsgBox "XMLHTTP object could not be created. Make sure you have the necessary references enabled.", vbExclamation
        Exit Sub
    End If
    On Error GoTo 0
      
    HttpReq.Open "POST", URL, False
    HttpReq.setRequestHeader "Content-Type", "application/json"
    HttpReq.Send WebhookData
    
    ' Check the response status and take approprate actions
    If HttpReq.Status >= 200 And HttpReq.Status < 300 Then
        MsgBox "Webhook request successful.", vbInformation
    Else
        MsgBox "Webhook request failed with status: " & HttpReq.Status & " - " & HttpReq.statusText, vbExclamation
    End If
    
    Set HttpReq = Nothing
    MsgBox "Webhook request sent with matched text: " & matchedText, vbInformation
End Sub

Function GetCurrentPreviewItem() As Object
    On Error Resume Next
    Set GetCurrentPreviewItem = objExplorerEventHandler.Explorer.Selection.Item(1)
    On Error GoTo 0
End Function

Function GetButtonEnabled(control As IRibbonControl) As Boolean
    ' Determine whether the custom button should be enabled or disabled based on the regex match
    GetButtonEnabled = (matchedText <> "")
End Function

然后我有一个 CustomRibbonCallbacks 类模块

Option Explicit

Public RibbonUI As Office.IRibbonUI

Public Function GetCustomUI(ByVal RibbonID As String) As String
    GetCustomUI = "<customUI xmlns='http://schemas.microsoft.com/office/2006/01/customui'>" & _
                  "  <ribbon>" & _
                  "    <tabs>" & _
                  "      <tab id='MyCustomTab' label='Custom'>" & _
                  "        <group id='MyCustomGroup' label='My Custom Group'>" & _
                  "          <button id='MyCustomButton' label='Send Webhook' imageMso='HappyFace' onAction='SendWebhook' getEnabled='IsButtonEnabled'/>" & _
                  "        </group>" & _
                  "      </tab>" & _
                  "    </tabs>" & _
                  "  </ribbon>" & _
                  "</customUI>"
End Function

Public Sub OnLoad(ribbon As Office.IRibbonUI)
    Set RibbonUI = ribbon
End Sub

Public Function IsButtonEnabled(control As IRibbonControl) As Boolean
    MsgBox "IsButtonEnabled started"
    ' This callback function is used to enable/disable the custom button
    ' based on whether the regex matched or not
    IsButtonEnabled = (Module1.matchedText <> "")
End Function

和ExplorerEventHandler 类模块

Option Explicit

Public WithEvents Explorer As Outlook.Explorer
Public RibbonUI As Office.IRibbonUI
Private isButtonAdded As Boolean

Private prevItem As Object ' Add a variable to store the previously previewed item

Public Sub InitializeRibbonUI(ByVal Inspector As Outlook.Inspector)
    Set RibbonUI = Inspector.RibbonUI
    ' Set the callback function for the custom button to control its state
    RibbonUI.ActivateTabMso "TabCustom"
    RibbonUI.InvalidateControl "MyCustomButton"
End Sub

Private Sub Explorer_SelectionChange()
    MsgBox "Explorer_SelectionChange started"
    ' This event will be triggered when the previewed item changes
    ' We will check if the selected item is an email and dynamically update the ribbon

    Dim currentItem As Object
    Set currentItem = GetCurrentPreviewItem()

    If currentItem Is Nothing Then
        Exit Sub
    End If

    ' Check if the prevItem variable has been initialized
    If prevItem Is Nothing Then
        ' Initialize it with the current previewed item
        Set prevItem = currentItem
        AddCustomButtonToRibbon
    Else
        ' Check if the current and previous items are the same to avoid unnecessary processing
        If currentItem Is prevItem Then
            Exit Sub
        Else
            ' Update the previously previewed item
            Set prevItem = currentItem
            AddCustomButtonToRibbon
        End If
    End If
End Sub

Private Sub Class_Terminate()
    MsgBox "Class_Terminate started"
    ' This event is triggered when the ExplorerEventHandler object is terminated (Outlook is closed)
    ' We remove the custom button when Outlook is closed
    If isButtonAdded Then
        RemoveCustomButton
    End If
End Sub

Private Sub AddCustomButtonToRibbon()
    MsgBox "AddCustomButtonToRibbon in ExplorerEventHandler started"
    
    ' Check if the Explorer object is set
    If Explorer Is Nothing Then
        Exit Sub
    End If
    
    Dim objItem As Object
    Set objItem = GetCurrentPreviewItem()

    If objItem Is Nothing Then
        Exit Sub
    End If

    ' Check if the previewed item is an email
    If TypeOf objItem Is Outlook.MailItem Then
        Dim emailContent As String
        emailContent = objItem.Body

        ' Use regular expression to find matches
        Dim regex As Object
        Set regex = CreateObject("VBScript.RegExp")
        With regex
            .Global = True
            .IgnoreCase = True
            .MultiLine = True
            .pattern = Module1.regexPattern ' Reference the regexPattern variable from the regular module
        End With

        Dim matches As Object
        Set matches = regex.Execute(emailContent)
        If matches.Count > 0 Then
            Module1.matchedText = matches(0).Value ' Update the matchedText variable in the regular module
        Else
            Module1.matchedText = "" ' Reset the matchedText if regex doesn't match
        End If

        UpdateCustomButtonState ' Update the custom button state (enabled/disabled)
    End If
    UpdateCustomButtonState ' Update the custom button state (enabled/disabled)
End Sub

Private Sub RemoveCustomButton()
    MsgBox "RemoveCustomButton started"
    Dim ribbon As Office.IRibbonUI
    Set ribbon = Me.RibbonUI
    If Not ribbon Is Nothing Then
        ribbon.InvalidateControl "MyCustomButton"
    End If
    isButtonAdded = False
End Sub

Private Sub UpdateCustomButtonState()
    Dim ribbon As Office.IRibbonUI
    Set ribbon = Me.RibbonUI
    If Not ribbon Is Nothing Then
        ' Enable or disable the button based on the matched text
        ribbon.InvalidateControl "MyCustomButton"
    End If
End Sub

Private Function GetCurrentPreviewItem() As Object
    MsgBox "GetCurrentPreviewItem started"
    On Error Resume Next
    Set GetCurrentPreviewItem = Explorer.Selection.Item(1)
    On Error GoTo 0
    
    ' Check if the Explorer object is set
    If Explorer Is Nothing Then
        Set GetCurrentPreviewItem = Nothing
    End If
End Function

最后是 ThisOutlookSession 对象

Option Explicit

Private WithEvents objInspectors As Outlook.Inspectors

Private Sub Application_Startup()
    Set objInspectors = Outlook.Application.Inspectors
    InitializeRibbon ' Call the InitializeRibbon procedure on startup
End Sub

Private Sub objInspectors_NewInspector(ByVal Inspector As Outlook.Inspector)
    If Inspector.currentItem.Class = olMail Then
        Dim objExplorerEventHandler As ExplorerEventHandler
        Set objExplorerEventHandler = New ExplorerEventHandler
        objExplorerEventHandler.InitializeRibbonUI Inspector
    End If
End Sub

我尝试简化脚本以消除类模块，并在主模块中概述所有内容。

vba outlook webhooks outlook-addin microsoft365
1个回答
0
投票

这不是您想要的答案，但是，IRibbonExtensibility接口（

GetCustomUI
方法是其中的成员）仅适用于COM AddIns（例如，您可以使用C#或VB.NET编写Visual Studio 或其他 IDE），不适用于 VBA。

据我所知，在 COM 插件之外，Outlook 中的功能区（和 QAT）只能使用用户界面进行自定义（即通过“文件”>“选项”>“自定义功能区/快速访问工具栏”手动执行此操作）。

最新问题
© www.soinside.com 2019 - 2024. All rights reserved.