Sending Outlook mail with signature using Excel VBA

Viewed 80

I am trying to send emails from Excel.

The VBA code below used to attach both files and included text with my Outlook standard signature.

Recently it failed, giving me the following error:

Application-defined or object-defined error

at the .HTMLBODY line.

When I remove the last .HTMLBody it runs but it excludes my signature.

Sub BodyVsHTMLBody()

    Dim ol As Outlook.Application
    Dim olMail As Outlook.MailItem

    Set ol = New Outlook.Application
    Set olMail = ol.CreateItem(olMailItem)

    With olMail
        .To = Sheet3.Range("C7").Value
        .CC = Sheet3.Range("C8").Value
        .Subject = Sheet3.Range("C9").Value
        .Attachments.Add Sheet3.Range("C11").Value
        .Attachments.Add Sheet3.Range("C12").Value
        .Display
        .HTMLBody = RangetoHTML(Sheet3.Range("C18")) & .HTMLBody
    End With
     
End Sub

Function RangetoHTML(rng As Range)

    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")

    TempWB.Close savechanges:=False

    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function
1 Answers

It seems the following line of code throws an error at runtime:

.HTMLBody = RangetoHTML(Sheet3.Range("C18")) & .HTMLBody

First of all, you need to keep in mind that HTMLBody is an HTML document which represents the message body. While Outlook may correct mistake when dealing with not well-formed HTML markup, to keep the document in a consistent state I'd suggest adding extra bits after opening <body> and before closing </body> tags. So, your HTML document will be well-formed and won't lead to glitches in the message body.

The problematic line of code contains a function call which returns some results. To find out what exactly it returns I'd recommend declaring a call on a separate line of code:

Dim tempReturn as String = RangetoHTML(Sheet3.Range("C18"))

There is no time to get the inspector initialized before asking the HTMLBody property in the code. So, I'd suggest calling the Display method first and then adding attachments, so the inspector window will be initialized and you can get the HTMLBody property.

Finally, the last bit is a security trigger while dealing with the Outlook object model. Try using the same code from the Outlook VBA environment where you don't need to create a new Application instance in the code. If the issue is not reproducible and the code is working correctly, that is it!

Related