VBA - How to add a custom outlook button that sends a webhook request

Question

I'm in way over my head with this and cannot get it to work. Ideally, I have a custom button on my Outlook ribbon that will send a webhook request. I cannot get the VBA script to successfully add the button. Additionally, I want the button to be disabled if the previewed email does not contain the regex pattern. I'm using Outlook for Microsoft 365 (Version 2305). I also have the Outlook Object Libraries, and VBScript Regular Expression References enabled in the VBA project.

Below is the main VBA module:

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

I then have a CustomRibbonCallbacks Class Module

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

And ExplorerEventHandler Class Module

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

And finally the ThisOutlookSession object

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

I've tried simplifying the scripts to eliminate the class modules and have everything outlined in the main module, but unsuccessful. I'd appreciate any pointers where to go from here.

score 0 · Answer 1 · answered Aug 19 '23 at 06:44

This is not the answer you want will be hoping for, however, the IRibbonExtensibility Interface (that the GetCustomUI method is a member of) is only for COM AddIns (eg that you might write in C# or VB.NET using Visual Studio or another IDE) and not for VBA.

AFAIK, outside of COM AddIns, the ribbon (and QAT) in Outlook can only be customised using the user-interface (that is, manually doing so via File > Options > Customize Ribbon / Quick Access Toolbar).

VBA - How to add a custom outlook button that sends a webhook request

1 Answers1