Attach Signature on Outlook using Excel Macro

Question

I hope you can help me as I am tearing my hair out, even though all my Googling tells me this should work...

I am trying to create a macro that sends an email from excel. It works but I have to manually add my signature before sending. Not the end of the world but annoying none the less.

When I have attempted to add the code to add my default signature it applies my signature but deletes the rest of the body.... PLEASE HELP!

Sub email()

        Dim Outlook_App As Object
        Dim Outlook_Mail As Object
        Dim emailBody  As String
        Dim ToBody As String
        Dim CCBody As String
        Dim BCCBody As String

        Set Outlook_App = CreateObject("Outlook.Application")
        Set Outlook_Mail = Outlook_App.CreateItem(0)

        ToBody = ThisWorkbook.Sheets("Test").Range("N9")
        CCBody = ThisWorkbook.Sheets("Test").Range("N10")
        BCCBody = ThisWorkbook.Sheets("Test").Range("N11")

        emailBody = "<BODY style=font-size:11pt;font-family:Calibri>Hi <br> <br>" & _
        "Your work has been randomly sampled. I have submitted your feedback on the Database. <br> <br>" & _
        "Please can you go in to review and accept your feedback within the next <b>5 working days?</b> <br> <br>" & _
        "<a href= """ & ThisWorkbook.Sheets("Test").Range("N12") & """>User Guide – How to Accept Feedback</a> <br>"

        On Error Resume Next

            With Outlook_Mail

                 .Display
                '.To = ToBody
                '.CC = CCBody
                '.bcc = BCCBody
                .Subject = "Feedback - Action Required"
                .HTMLBody = emailBody & .HTMLBody

            End With

        On Error GoTo 0

        Set Outlook_Mail = Nothing
        Set Outlook_App = Nothing

        End Sub

Does any error appears if you execute code deleting the line `On Error Resume Next`? — Foxfire And Burns And Burns, Dec 17 '18 at 13:22
There was a similar issue posted on the forum - please check Julia's answer which creates an email body and also keeps the default signature (if you have one). It looks like emailBody is responsible for deleting your default signature. [How to add default signature in outlook](https://stackoverflow.com/questions/8994116/how-to-add-default-signature-in-outlook) — Justyna MK, Dec 17 '18 at 14:52
Thank you Justyna I will check and see if it helps! Foxfire I get runtime error 287 - when I debug it takes issue with the .htmlbody line, no idea why! — Lindsey, Dec 17 '18 at 17:54
@JustynaMK Turns out I had already tried Julia's answer, I get runtime 287 error on signature = OMail.body, any ideas? — Lindsey, Dec 17 '18 at 18:28

score 0 · Answer 1 · answered Dec 17 '18 at 18:57

You cannot simply concatenate two HTML strings and expect a valid HTML string back. The two must be merged.

In the simplest case, read the HTMLBody property (after you called Display), search for the "<body" substring, find the next ">" (this will take care of the body element with attributes), then insert your HTML string (without the body element of course).

score 0 · Answer 2 · answered Dec 18 '18 at 07:01

According to my search and test, you could refer to the below code:

Sub addUpdate_Click()
Dim mailObj As MailItem
Dim emailBody, signature As String
Dim Outlook_App, Outlook_Mail As Object
Dim ToBody As String
Dim CCBody As String
Dim BCCBody As String

Set Outlook_App = CreateObject("Outlook.Application")
Set Outlook_Mail = Outlook_App.CreateItem(0)

ToBody = ThisWorkbook.Sheets("Test").Range("N9")
CCBody = ThisWorkbook.Sheets("Test").Range("N10")
BCCBody = ThisWorkbook.Sheets("Test").Range("N11")

With Outlook_Mail
    .BodyFormat = olFormatHTML
    .Display
End With
signature = Outlook_Mail.HTMLBody

Set mailObj = CreateItem(olMailItem)

emailBody = "<BODY style=font-size:11pt;font-family:Calibri>Hi <br> <br>" & _
        "Your work has been randomly sampled. I have submitted your feedback on the Database. <br> <br>" & _
        "Please can you go in to review and accept your feedback within the next <b>5 working days?</b> <br> <br>" & _
        "<a href= """ & ThisWorkbook.Sheets("Test").Range("N12") & """>User Guide – How to Accept Feedback</a> <br>"

        On Error Resume Next

            With Outlook_Mail

                 .Display
                '.To = ToBody
                '.CC = CCBody
                '.bcc = BCCBody
                .Subject = "Feedback - Action Required"
                .HTMLBody = emailBody & signature

            End With
On Error GoTo 0

        Set Outlook_Mail = Nothing
        Set Outlook_App = Nothing

End Sub

Reference from:

Adding a default signature to outlook email VBA

How to add default signature in Outlook

Attach Signature on Outlook using Excel Macro

2 Answers2