Create email with signature

There have been many different claims on how to insert email signatures, however I have found none of them work for me because whenever I would run the given code the signature would be wiped out when the email message was inserted.

So, after looking and searching for several months I finally found one that could be modified but it still took work to get it to run.

Here is the code that works using VBA and HTML. Don't get scared by the HTML part if you don't know HTML.

The main part is VBA but the message is HTML. One thing to keep in mind with HTML is that the <P> and </P> act as a start and stop to a paragraph and <br /> acts as VBCRLF.

I commented out the save and send portions so you can view the email without fear.

Here it is -

Sub Send_Email_With_Signature()

Dim ESubject as string
Dim Contact_Email as string
Dim Contact_Name as string

Dim APP
Dim Item


' Just in case something goes wrong
On Error GoTo Error_Handler

ESubject = "Test of email signature"

Contact_Email = "Someone@Someplace.com"

Contact_Name = "Barney Fife"

Ebody = "<P>Dear " & Contact_name & ",</P>"
Ebody = Ebody _
& "<p>Please read this email to verify the signature </p>" & _
"<p>This email will show the signature <br />" & _
"at the bottom of the email </p>" & _
"<p> Thank you</p>"

' Creating An email
Set App = CreateObject("Outlook.Application")
Set Itm = App.CreateItem(0)

With Itm

' Show the user the email that was just created
.Display

End With


With Itm

' Put the subject line info in the subject line
.Subject = ESubject

' Put who the email is going to in the to line
.To = Contact_Email

' Insert the message into the email
.HTMLBody = Ebody & .HTMLBody

' To save the email
'.Save

' Send the email
'.Send

End With


' Clear and exit email
Set App = Nothing
Set Itm = Nothing

Exit Sub

Error_Handler:

' Clear and exit email
Set App = Nothing
Set Itm = Nothing

' Let the user know something is wrong
MsgBox Err.Description & " See Status Bar"

'Tell the user what went wrong
Application.StatusBar = "Send_Email failed. " & Err.Description

End Sub