Home > OS >  VBA Outlook HTMLBody Signature
VBA Outlook HTMLBody Signature

Time:11-16

New to VBA. Trying to automate some emails for work.

Need to add my signature at the end of a generated Outlook email. I changed my (.HTMLBody = msg) to (.HTMLBody = msg & .HTMLBody). This got my signature to display but my msg text vanished. When I removed the .HTMLBody at the end and use my original code, my text appears formatted correctly but no signature.

Sub Email()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim Path As String
    Dim strbody As String

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

    msg = "<p>Hello World,</p><br>"

    On Error Resume Next
    With OutMail
        .Display
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = "Fruits Stock " & Path
        .HTMLBody = msg & "Hello World" & .HTMLBody

    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Any help here would be amazing.

CodePudding user response:

Have you had a search using Google about MailItem.HTMLBody?

It shows an example here:

Sub CreateHTMLMail() 
 
 'Creates a new email item and modifies its properties. 
 
 Dim objMail As Outlook.MailItem 
 
 
 
 'Create email item 
 
 Set objMail = Application.CreateItem(olMailItem) 
 
 With objMail 
 
 'Set body format to HTML 
 
 .BodyFormat = olFormatHTML 
 
 .HTMLBody = _ 
 
 "<HTML><BODY>Enter the message text here. </BODY></HTML>" 
 
 .Display 
 
 End With 
 
End Sub

If you want your email to be in HTMl format they you need to set a flag:

.BodyFormat = olFormatHTML


Lookup the MailItem.BodyFormat property.

CodePudding user response:

I had a similar problem when creating a loop for sending emails with a specific signature - in my case I had to pick from one of a few signatures as it could vary for each email.

I passed the signature name as a string variable Signame into a separate function, used to add the signature onto an email.

'Code trimmed down a lot to just relevant bits
Sub Email()
'Create email here
Dim Email as outlook.mailitem
Set Email = Application.Createitem(olMailItem)
Email.Htmlbody = "<p>Hello World</p>" & AddSig("My_Signature")
Email.display
End Sub

Function AddSig(Signame as string)
If Len(Signame) > 0 Then
    Dim fso As Object, ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject"): Set ts = fso.GetFile(Environ("Appdata") & "\Microsoft\Signatures\" & Signame & ".htm").OpenAsTextStream(1, -2)
    Signame = Replace(Signame, " ", " ")
    AddSig = "<br>" & Replace(ts.ReadAll, _
        Signame & "_files", _
        Replace(Environ("Appdata"), " ", " ") & "\Microsoft\Signatures\" & Signame & "_files")
End If
End Function

So just substitute your signature name where I've put "My_Signature". HOWEVER this doesn't work for signatures with a space in their name, despite my efforts with replace(Signame, " ", " ") - it's something to do with the HTML. I just renamed my signatures to remove all spaces, but if anyone seeing this gives it a try and manages to debug that I'd personally be extremely grateful!

  • Related