vbaoutlook

Trigger Outlook Event: Change Signature


Does anyone know if it possible to trigger a signature change event in Outlook 2016? I.e. Simulate clicking a signature as per the screenshot below:

enter image description here

I am trying to change the signature automatically based on which 'From' address has been selected. I can capture the 'From' address change (as answered here).

However I cannot find a way to programmatically change the signature. My research has gotten as far as concluding that the CommandBar object is deprecated in Office 2016 and that I need to interact with the IRibbonUI object. Or perhaps some other Ribbon object? Or perhaps there is better way of selecting the signature other than faking a button click?

I cannot find a Signature object in the Outlook namespace with leads me to conclude that the MailItem class does not know about signatures - it only knows about body text. However what is odd is that I can right-click on the signature body and bring up a context menu: enter image description here

So some object somewhere must know about signatures - perhaps the email editor?

Many thanks


Solution

  • Wow OK so figured this out but it is quite a roundabout way of achieving the result. Thanks to @niton for this handy comment to point me in the right direction.

    In summary it performs the following:

    Here is the code I have implemented so far:

    Dim WithEvents myInspector As Outlook.Inspectors
    Dim WithEvents myMailItem As Outlook.MailItem
    
    Private Sub Application_Startup()
    
        Set myInspector = Application.Inspectors
    
    End Sub
    
    Private Sub myInspector_NewInspector(ByVal Inspector As Outlook.Inspector)
    
        If TypeOf Inspector.CurrentItem Is MailItem Then
            Set myMailItem = Inspector.CurrentItem
        End If
    
    End Sub
    
    Private Sub myMailItem_PropertyChange(ByVal Name As String)
    On Error GoTo ErrorCatcher
    
        Dim signatureName As String
        Dim signatureFilePath As String
    
        ' Properties we are interested in: "SendUsingAccount" / "SentOnBehalfOfName"
        ' Both get fired when the 'From' field is changed/re-selected
        ' So we are only going to trigger on one event or we will call the code twice
        If Name = "SentOnBehalfOfName" Then
    
            ' Delete the current signature
            Call DeleteSignature(myMailItem)
    
            ' Insert the new signature at the current cursor point
            ' The cursor will be at the point where the old signature was deleted
            signatureName = GetSignatureName(myMailItem.SentOnBehalfOfName)
            signatureFilePath = GetSignatureFilePath(signatureName)
            Call InsertSignature(myMailItem, signatureFilePath)
    
        End If
    
        Exit Sub
    
    ErrorCatcher:
    
        MsgBox Err.Description
    
    End Sub
    
    Private Function DeleteSignature(objMail As MailItem)
    
        Dim objDoc As Word.Document
        Dim objBkm As Word.Bookmark
    
        Set objDoc = objMail.GetInspector.WordEditor
    
        If objDoc.Bookmarks.Exists("_MailAutoSig") Then
            Set objBkm = objDoc.Bookmarks("_MailAutoSig")
            objBkm.Select
            objDoc.Windows(1).Selection.Delete
        End If
    
    End Function
    
    Private Function GetSignatureName(sender As String)
    
        Select Case sender
    
            Case "Sender Name 1"
                GetSignatureName = "Signature 1"
    
            Case "Sender Name 2"
                GetSignatureName = "Signature 2"
    
            Case Else
                GetSignatureName = "Default"
    
        End Select
    
    
    End Function
    
    Private Function GetSignatureFilePath(signatureName As String) As String
    
        GetSignatureFilePath = Environ("AppData") & "\Microsoft\Signatures\" & signatureName & ".htm"
    
    End Function
    
    Private Function InsertSignature(objMail As MailItem, signatureFilePath As String)
    
        Dim objDoc As Word.Document
        Dim rngStart As Range
        Dim rngEnd As Range
    
        Set objDoc = objMail.GetInspector.WordEditor
    
        Set rngStart = objDoc.Application.Selection.Range
        rngStart.Collapse wdCollapseStart
    
        Set rngEnd = rngStart.Duplicate
        rngEnd.InsertParagraph
    
        rngStart.InsertFile signatureFilePath, , , , False
        rngEnd.Characters.Last.Delete
    
        objDoc.Bookmarks.Add "_MailAutoSig", rngEnd
    
    End Function