How to add default signature in Outlook

The code below will create an outlook message & keep the auto signature

Dim OApp As Object, OMail As Object, signature As String

Set OApp = CreateObject("Outlook.Application")
Set OMail = OApp.CreateItem(0)

With OMail
    .Display
End With

signature = OMail.body

With OMail
    '.To = "[email protected]"
    '.Subject = "Type your email subject here"
    '.Attachments.Add
    .body = "Add body text here" & vbNewLine & signature
    '.Send
End With

Set OMail = Nothing
Set OApp = Nothing

Dim OutApp As Object, OutMail As Object, LogFile As String
Dim cell As Range, S As String, WMBody As String, lFile As Long

S = Environ("appdata") & "\Microsoft\Signatures\"
If Dir(S, vbDirectory) <> vbNullString Then S = S & Dir$(S & "*.htm") Else S = ""
S = CreateObject("Scripting.FileSystemObject").GetFile(S).OpenAsTextStream(1,  -2).ReadAll

WMBody = "<br>Hi All,<br><br>" & _
         "Last line,<br><br>" & S 'Add the Signature to end of HTML Body

Just thought I'd share how I achieve this. Not too sure if it's correct in the defining variables sense but it's small and easy to read which is what I like.

I attach WMBody to .HTMLBody within the object Outlook.Application OLE.

Hope it helps someone.

Thanks, Wes.

My solution is to display an empty message first (with default signature!) and insert the intended strHTMLBody into the existing HTMLBody.

If, like PowerUser states, the signature is wiped out while editing HTMLBody you might consider storing the contents of ObjMail.HTMLBody into variable strTemp immediately after ObjMail.Display and add strTemp afterwards but that should not be necessary.

Sub X(strTo as string, strSubject as string, strHTMLBody as string)

   Dim OlApp As Outlook.Application   
   Dim ObjMail As Outlook.MailItem 

   Set OlApp = Outlook.Application
   Set ObjMail = OlApp.CreateItem(olMailItem)

   ObjMail.To = strTo
   ObjMail.Subject = strSubject   
   ObjMail.Display
   'You now have the default signature within ObjMail.HTMLBody.
   'Add this after adding strHTMLBody
   ObjMail.HTMLBody = strHTMLBody & ObjMail.HTMLBody

   'ObjMail.Send 'send immediately or 
   'ObjMail.close olSave 'save as draft
   'Set OlApp = Nothing

End sub