Inserting email signature using vba in Excel 2013

Question

This sub in an Excel vba application has worked well for years, inserting an Outlook signature into an email before displaying the email for me to send (.Display). This has worked in Excel 2007 in XL and 2013 in Windows 7.

Now I have Windows 8.1 and Office 2013 this comes out with Error 91 in my error routine. Could it be a problem with one of the References? - or some change needed in the code? All help gratefully received!

Sub InsertSig2007(strSigName As String)

Dim objItem As Object
Dim objInsp As Outlook.Inspector
' requires a project reference to the
' Microsoft Office library
Dim objCBP As Office.CommandBarPopup
Dim objCBP2 As Office.CommandBarPopup
Dim objCBB As Office.CommandBarButton
Dim colCBControls As Office.CommandBarControls
Set objInsp = ActiveInspector
If Not objInsp Is Nothing Then
    Set objItem = objInsp.CurrentItem
    If objItem.Class = olMail Then
    ' get Insert menu
        Set objCBP = objInsp.CommandBars.ActiveMenuBar.FindControl(, 30005)
        ' get Signature submenu
        Set objCBP2 = objCBP.CommandBar.FindControl(, 5608)
        If Not objCBP2 Is Nothing Then
            Set colCBControls = objCBP2.Controls
            For Each objCBB In colCBControls
            Debug.Print objCBB.Caption
            If objCBB.Caption = strSigName Then
                objCBB.Execute ' **** see remarks
                Exit For
            End If
            Next
        End If
    End If
End If
Set objInsp = Nothing
Set objItem = Nothing
Set colCBControls = Nothing
Set objCBB = Nothing
Set objCBP = Nothing
Set objCBP2 = Nothing

End Sub

Answer 1

"this comes out with Error 91 in my error routine" When debugging do not use an error routine. That way you see the line with the problem and can say what it is in your question.

It is probably

Set objCBP = objInsp.CommandBars.ActiveMenuBar.FindControl(, 30005)

See CommandBars.FindControl Method (Office) "The use of CommandBars in some Microsoft Office applications has been superseded by the new ribbon component of the Microsoft Office Fluent user interface."

Note: CommandBars.ExecuteMso Method (Office) works in 2013 but I believe the signature button is not available.

You will surely find a replacement for your code here Insert Outlook Signature in mail .

Likely this one:

Sub Mail_Outlook_With_Signature_Html_2()
' Don't forget to copy the function GetBoiler in the module.
' Working in Office 2000-2013
    'Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim SigString As String
    Dim Signature As String

    'Set OutApp = CreateObject("Outlook.Application")
    'Set OutMail = OutApp.CreateItem(0)

    Set OutMail = CreateItem(0)

    strbody = "<H3><B>Dear Customer Ron de Bruin</B></H3>" & _
              "Please visit this website to download the new version.<br>" & _
              "Let me know if you have problems.<br>" & _
              "<A HREF=""http://www.rondebruin.nl/tips.htm"">Ron's Excel Page</A>" & _
              "<br><br><B>Thank you</B>"

    'Change only Mysig.htm to the name of your signature
    SigString = Environ("appdata") & _
                "\Microsoft\Signatures\Mysig.htm"

    If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If

    On Error Resume Next

    With OutMail
        '.To = "ron@debruin.nl"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .HTMLBody = strbody & "<br>" & Signature
        '.Send    
        'or use 
        .Display
    End With

    On Error GoTo 0
    Set OutMail = Nothing
    'Set OutApp = Nothing
End Sub


Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function