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