One of my most popular posts is my function for sending e-mail using Outlook automation: VBA – Send HTML Emails Using Outlook Automation. That said, there is an issue with that code, the way I retain the signature in the generate e-mail.
The Problem With Concatenation of .HTMLBody
Although this is the most common approach seen online (from what I have seen over the years); to concatenate the message we want to send with the existing body when the e-mail is first created:
.HTMLBody = sMyHTMLMessage & .HTMLBody
The issue being that .HTMLBody will already be a complete HTML document
<html ...> <head>...</head> <body ...> ... </body> </html>
and the concatenation is prepending the user’s message at the beginning, outside the html/body tags, resulting in
The User's Message is prepended here! <html ...> <head>...</head> <body ...> ... </body> </html>
which is simply incorrect HTML!
Now, some e-mail clients, such as Outlook, deal with this just fine, but this can cause issue for others. As such, I wanted to find a way to generate an HTML e-mail while creating proper HTML.
The Solution
The solution isn’t very complex, just a question of juggling the initial .HTMLBody string a bit and insert our message at the right location; ie after the
tag.As such, we would take
.HTMLBody = sBody & .HTMLBody
and transform it into
sHTML = .HTMLBody
aHTML = Split(sHTML, "<body")
aSubHTML = Split(aHTML(1), ">")
sHTML = aHTML(0) & "<body" & aSubHTML(0) & ">" & _
sBody & _
Right(aHTML(1), Len(aHTML(1)) - Len(aSubHTML(0) & ">"))
.HTMLBody = sHTML
which then generates proper html content while preserving the signature.
<html ...> <head>...</head> <body ...> The User's Message is prepended here! </body> </html>
Wrapped Up in a Bow
So Taking what we learned above, the entire function then simply becomes
'---------------------------------------------------------------------------------------
' Procedure : SendHTMLEmail
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Automate Outlook to send an HTML email with or without attachments
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
' (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Late Binding version -> None required
' Early Binding version -> Ref to Microsoft Outlook XX.X Object Library
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sTo : To Recipient email address string (semi-colon separated list)
' sSubject : Text string (HTML) to be used as the email subject line
' sBody : Text string to be used as the email body (actual message)
' bEdit : True/False whether or not you wish to preview the email before sending
' vCC : CC Recipient email address string (semi-colon separated list)
' vBCC : BCC Recipient email address string (semi-colon separated list)
' vAttachments : Array of attachment (complete file paths with
' filename and extensions)
' vAccount : Name of the Account to use for sending the email (normally the e-mail address)
' if no match is found it uses the default account
' vEmbeddedImages: A 2 dimensional array of files and unique ids to be used as embedded
' images within the body HTML
' bReadReceipt: True/False request read receipt or not
'
' Usage:
' ~~~~~~
' Email displayed to the user
' Call SendHTMLEmail("abc@xyz.com", "My Subject", "<p>My <b>body</b>.</p>", True)
' Email sent automatically, no user interaction
' Call SendHTMLEmail("abc@xyz.com", "My Subject", "<p>My <b>body</b>.</p>", False)
' Email with multiple To recipients and displayed to the user
' Call SendHTMLEmail("abc@xyz.com;def@wuv.ca;", "My Subject", "<p>My <b>body</b>.</p>", True)
' Email with a single attachment and displayed to the user
' Call SendHTMLEmail("abc@xyz.com", "My Subject", "<p>My <b>body</b>.</p>", True, , _
' Array("C:\Temp\Table2.txt"))
' Email with a 2 attachment and displayed to the user
' Call SendHTMLEmail("abc@xyz.com", "My Subject", "<p>My <b>body</b>.</p>", True, , _
' Array("C:\Temp\Table2.txt", "C:\Temp\Supplier List.txt"))
' Email with a 2 attachment, using a specific account and displayed to the user
' Call SendHTMLEmail("abc@xyz.com", "My Subject", "<p>My <b>body</b>.</p>", True, , _
' Array("C:\Temp\Table2.txt", "C:\Temp\Supplier List.txt"), _
' "cde@uvw.com")
' Email with a 2 attachment, using a specific account and send without being displayed
' Call SendHTMLEmail("abc@xyz.com", "My Subject", "<p>My <b>body</b>.</p>", True, , _
' Split("C:\Temp\Table2.txt,C:\Temp\Supplier List.txt", ","), _
' "cde@uvw.com")
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2007-11-16 Initial Release
' 2 2017-02-15 Added retention of default e-mail signature
' Added conditional compiler directives for early and
' late binding
' 3 2019-01-20 Updated Copyright
' Added usage examples
' Added sAccount option
' 4 2019-09-06 Updated the handling of sTo and sBCC to split e-mail
' addresses into individual recipients and
' improved error reporting for unresolvable e-mail
' addresses per an issue flagged by InnVis (MSDN)
' 5 2020-03-12 Bugs fixes (missing declarations) from comments by
' S.A.Marshall in answers forum
' Added CC to function
' 6 2020-12-08 Proper parsing of .HTMLBody so proper HTML is
' generated
' 7 2021-02-19 Added Split() example to usage examples
' 8 2022-09-29 Added vEmbeddedImages to handle embedding images in
' the email body.
' Add bReadReceipt for requesting Read Receipts
'---------------------------------------------------------------------------------------
Function SendHTMLEmail(ByVal sTo As String, _
ByVal sSubject As String, _
ByVal sBody As String, _
ByVal bEdit As Boolean, _
Optional vCC As Variant, _
Optional vBCC As Variant, _
Optional vAttachments As Variant, _
Optional vAccount As Variant, _
Optional vEmbeddedImages As Variant, _
Optional bReadReceipt As Boolean = False)
On Error GoTo Error_Handler
' #Const EarlyBind = 1 'Use Early Binding
#Const EarlyBind = 0 'Use Late Binding
#If EarlyBind Then
Dim oOutlook As Outlook.Application
Dim oOutlookMsg As Outlook.MailItem
Dim oOutlookInsp As Outlook.Inspector
Dim oOutlookRecip As Outlook.Recipient
Dim oOutlookAttach As Outlook.Attachment
Dim oOutlookAccount As Outlook.Account
#Else
Dim oOutlook As Object
Dim oOutlookMsg As Object
Dim oOutlookInsp As Object
Dim oOutlookRecip As Object
Dim oOutlookAttach As Object
Dim oOutlookAccount As Object
Const olMailItem = 0
Const olFormatHTML = 2
#End If
Dim sHTML As String
Dim aHTML As Variant
Dim aSubHTML As Variant
Dim aRecip As Variant
Dim i As Integer
Set oOutlook = CreateObject("Outlook.Application")
Set oOutlookMsg = oOutlook.CreateItem(olMailItem)
With oOutlookMsg
'Account to use for sending, if specified, otherwise use default
If Not IsMissing(vAccount) Then
For Each oOutlookAccount In oOutlook.Session.Accounts
If oOutlookAccount = vAccount Then
Set oOutlookMsg.SendUsingAccount = oOutlookAccount
End If
Next
End If
.Display 'Had to move this command here to resolve a bug only existent in Access 2016!
'TO
aRecip = Split(sTo, ";")
For i = 0 To UBound(aRecip)
If Trim(aRecip(i) & "") <> "" Then
Set oOutlookRecip = .Recipients.Add(aRecip(i))
oOutlookRecip.Type = 1
End If
Next i
'CC
If Not IsMissing(vCC) Then
aRecip = Split(vCC, ";")
For i = 0 To UBound(aRecip)
If Trim(aRecip(i) & "") <> "" Then
Set oOutlookRecip = .Recipients.Add(aRecip(i))
oOutlookRecip.Type = 2
End If
Next i
End If
'BCC
If Not IsMissing(vBCC) Then
aRecip = Split(vBCC, ";")
For i = 0 To UBound(aRecip)
If Trim(aRecip(i) & "") <> "" Then
Set oOutlookRecip = .Recipients.Add(aRecip(i))
oOutlookRecip.Type = 3
End If
Next i
End If
'Process the embedded images, if applicable
If Not IsMissing(vEmbeddedImages) Then
For i = 0 To UBound(vEmbeddedImages)
If vEmbeddedImages(i, 0) <> "" Then
'Add the image as an attachment
Set oOutlookAttach = .Attachments.Add(vEmbeddedImages(i, 0))
'Associate the unique ID to the attachment so it can be used in the HTML
Call oOutlookAttach.PropertyAccessor.SetProperty( _
"http://schemas.microsoft.com/mapi/proptag/0x3712001F", _
CStr(vEmbeddedImages(i, 1)))
End If
Next i
End If
.Subject = sSubject
Set oOutlookInsp = .GetInspector 'Retains the signature if applicable
sHTML = .HTMLBody
aHTML = Split(sHTML, "<body")
aSubHTML = Split(aHTML(1), ">")
sHTML = aHTML(0) & "<body" & aSubHTML(0) & ">" & _
sBody & _
Right(aHTML(1), Len(aHTML(1)) - Len(aSubHTML(0) & ">"))
.HTMLBody = sHTML
.BodyFormat = olFormatHTML
.Importance = 1 'Importance Level 0=Low,1=Normal,2=High
.ReadReceiptRequested = bReadReceipt
' Add attachments to the message.
If Not IsMissing(vAttachments) Then
If IsArray(vAttachments) Then
For i = LBound(vAttachments) To UBound(vAttachments)
If vAttachments(i) <> "" And vAttachments(i) <> "False" Then
Set oOutlookAttach = .Attachments.Add(vAttachments(i))
End If
Next i
Else
If vAttachments <> "" Then
Set oOutlookAttach = .Attachments.Add(vAttachments)
End If
End If
End If
For Each oOutlookRecip In .Recipients
If Not oOutlookRecip.Resolve Then
'You may wish to make this a MsgBox! to show the user that there is a problem
Debug.Print "Could not resolve the e-mail address: ", oOutlookRecip.Name, oOutlookRecip.Address, _
Switch(oOutlookRecip.Type = 1, "TO", _
oOutlookRecip.Type = 2, "CC", _
oOutlookRecip.Type = 3, "BCC")
bEdit = True 'Problem so let display the message to the user so they can address it.
End If
Next
If bEdit = True Then 'Choose btw transparent/silent send and preview send
'.Display 'Preview
Else
.Send 'Automatically send the e-mail w/o user intervention
End If
End With
Error_Handler_Exit:
On Error Resume Next
If Not oOutlookAccount Is Nothing Then Set oOutlookAccount = Nothing
If Not oOutlookAttach Is Nothing Then Set oOutlookAttach = Nothing
If Not oOutlookRecip Is Nothing Then Set oOutlookRecip = Nothing
If Not oOutlookInsp Is Nothing Then Set oOutlookInsp = Nothing
If Not oOutlookMsg Is Nothing Then Set oOutlookMsg = Nothing
If Not oOutlook Is Nothing Then Set oOutlook = Nothing
Exit Function
Error_Handler:
If Err.Number = "287" Then
MsgBox "You clicked No to the Outlook security warning. " & _
"Rerun the procedure and click Yes to access e-mail " & _
"addresses to send your message. For more information, " & _
"see the document at http://www.microsoft.com/office" & _
"/previous/outlook/downloads/security.asp."
Else
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: SendHTMLEmail" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occurred!"
End If
Resume Error_Handler_Exit
End Function
Usage
In the function header I’ve included several usage examples, but I wanted to give one example of using embedded images as this is a little trickier since we have to build and pass a 2-dimensional array to the function.
Below is an example of how you do so to embed 3 images within the email body itself, add a read receipt request and display it to the user:
Sub ImageTest()
Dim sHTML As String 'E-mail body message
Dim sEmbeddedImages(2, 1) As String 'Array holding embedded image list, adjust 3 to number of image - 1 (0 based)
' 2,1 = 3 images, 2 columns (file, id)
' 4,1 = 5 images, 2 columns (file, id)
' 0,1 = 1 images, 2 columns (file, id)
'Build our embedded image array
'**************************************
'1st image
sEmbeddedImages(0, 0) = "C:\Temp\Capture.PNG" 'File
sEmbeddedImages(0, 1) = "capture" 'Unique cid / Used in body HTML
'2nd image
sEmbeddedImages(1, 0) = "C:\Temp\screenshot01.jpg" 'File
sEmbeddedImages(1, 1) = "screenshot" 'Unique cid / Used in body HTML
'3rd image
sEmbeddedImages(2, 0) = "C:\Temp\ExportImageTest06.png" 'File
sEmbeddedImages(2, 1) = "test" 'Unique cid / Used in body HTML
'Build our HTML email message
'**************************************
sHTML = "Hello <b>World</b>"
sHTML = sHTML & "<br><br><br><h3>Image 1</h3><img src=""cid:capture"">"
sHTML = sHTML & "<br><br><h3>Image 2</h3><img src=""cid:test"">"
sHTML = sHTML & "<br><br><h3>Image 3</h3><img src=""cid:screenshot"">"
'Run the function to generate the email
'**************************************
Call SendHTMLEmail("someone@somewhere.com", "My Subject", sHTML, True, , , , , sEmbeddedImages(), True)
End Sub
I am trying the first time to utilize this function in one of my Access Applications. I have an error message which I can not figure out with my attachments. Following is the example:
I create a string for sAttachments which is \\WSKF01\admbew\BLAJS\ZIP-Erstellung\Test1.txt, \\WSKF01\admbew\BLAJS\ZIP-Erstellung\Test2.txt
If I Call SendHTMLEmail(sTo, sSubject, “” & sBody & “.”, True, , , Array(sAttachments)) I receive the error message, that the attachments could not be found.
If I add the exactly same string directly in Call SendHTMLEmail(sTo, sSubject, “” & sBody & “.”, True, , , Array(“\\WSKF01\admbew\BLAJS\ZIP-Erstellung\Test1.txt”, “\\WSKF01\admbew\BLAJS\ZIP-Erstellung\Test2.txt”))
the documents get attached to the Email without an error message. Not sure how to proceed, do I need to create the string for sAttachments with apostrophes or what else could I possibly do wrongly here. I will appreciate any hint and thak you for your efforts to publish such a nice function.
The following works just fine for me.
Dim sAttachments As String Dim sTo As String Dim sSubject As String Dim sBody As String sTo = "someone@somewhere.com" sSubject = "Test" sBody = "Testing SendHTMLEmail" sAttachments = "C:\...\...\test.xls" Call SendHTMLEmail(sTo, sSubject, sBody & ".", True, , , Array(sAttachments))Now if what you are saying is that sAttachments is comprised of multiple attachments as a single string, then in that case, you can’t just pass that string to the Array function, it will treat the string as a single element and, yes, you will get an error. For a situation like that you would need to do something like
Dim sAttachments As String Dim sTo As String Dim sSubject As String Dim sBody As String sTo = "someone@somewhere.com" sSubject = "Test" sBody = "Testing SendHTMLEmail" sAttachments = "C:\...\...\test1.xls,C:\...\...\test2.xls,C:\...\...\test3.xls" Call SendHTMLEmail(sTo, sSubject, sBody & ".", True, , , Split(sAttachments, ","))in which you pass your sAttachments to the Split function which breaks your string components and automatically converts the elements into an array which get passed to the SendHTMLEmail function.
I hope this helps.
THANK YOU very much for taking your time to respond. Your suggested Split function works perfectly for my application.
My pleasure. I will be updating my usage section in the function header as I think this may help others.
Maybe one short remark, which you might want to incorporate into your ammendment – I have altered your proposed function Split(sAttachments, “,”) to Split(Nz(sAttachments), “,”). Otherwise I received an error message when the attachment field has been empty.
Your support and willingness to share this function are much appreciated. Thank you.
Daniel – Thank you for posting this code. I was using the DoCmd.SendObject in my database but ran into limitation with the 255 character length for the message body so am thinking of switching to your code but I have two questions:
A. How do I put character returns in sBody? I tried building a string with vbNewLine but it didn’t work. Do I need to use chr(10) or chr(13)?
B. If the user ends up not sending the email, can your function report that back? I need to use that information to update a field in the database.
Thanks.
Since my code is using .HTMLBody it is expecting proper HTML code/tags, so you would either make lines using the paragraph tags
Or you can use the br tag
Or a combination of both
As for your second question, I think this is where you would need to use With Events …
Thanks for the response. I realized soon after I posted that my question about line feeds was silly because of course I would have to use HTML.
As for capturing that the email wasn’t sent, I will have to experiment with the Sent property of Outlook mail items. I just thought you might have already built a solution.
Thanks again.
Daniel,
Following up to my previous reply, I tried adding a class module with some very basic code below but I cannot get the event to run. Any suggestions on what I am doing wrong? Thanks, Jason.
Public WithEvents oOutlookMsg As Outlook.MailItem
Private Sub oOutlookMsg_Send(Cancel As Boolean)
If Not oOutlookMsg.sent Then
Beep
MsgBox “Email not sent.”
End If
End Sub
This script works fine for me (I have it configured without preview of message) when I have Outlook 365 open but when it’s closed it doesn’t actually send the email, rather it stays in the Outbox until I open Outlook and then it sends it. It looks like it’s sending it when Outlook is closed because there is some activity on the Outlook icon in the system tray and the generated email actually pops up on the screen for a second or so. I checked and I have Outlook options set to send immediately. Am I missing something or is there a fix/workaround for this?
Hi,
Your code works really well for me when I use the methods .save or .display but I get a system error when I try to use .send
The error is 5 – invalid procedure call or argument.
Are you able to give any pointers on how to fix this?
Thanks.
same problem here
This is an amazing solution. Thank you for making it available.
Thank you once again, Daniel!
My question is if the earlier article (2014)
”CreateObject(“Outlook.Application”) Does Not Work, Now What? ”- approach is not necessary any more?
i got this error when starting the vba script
Run-time error ‘-2147221164 (80040154)’:
An OLE registration error occurred. The problem is not correctly installed. Run Setup again for the program
I don’t think I’ve ever encountered that error. Does the PC in question have Outlook installed and configured?
Hi daniel, yes
it,s Outlook 365 E3 account and installed, see error screenshot
https://i.postimg.cc/wvDXJmxX/outlook.jpg
I truly do not know. Perhaps start by trying an Office Repair? The code compiles properly for you?
maybe stupid question, but the code is directly inside outlook , or do i have to make a visual studio office outlook app ?
inside outlook the error starts after the next lines , if i remove these sub it starts without error, but no change in signature.
Sub TestSig()
Dim sSig As String
Dim sMsg As String
sSig = Outlook_GetSignature ( this line only already gives the error )
‘ sMsg = “Just Testing Outlook Automation.” & sSig
‘ Call Outlook_GetSignature
End Sub
This was created to retrieve the signature so it can be extracted and used elsewhere. There’d be no need with Outlook itself as it is already available there. This would be something you’d call to add to the HTML of an e-mail you are building externally or when performing Outlook automation from another application.
Also, it is simple retrieving the HTML of the signature file, in no way is it changing the signature.
Hi Daniel,
I know, but it,s not retrieving any signature in the mail body, i tried another device with outlook, and get the same error. if possible you can see with teamviewer
If you run the command in the VBA/VBE Immediate Window
do you get an HTML string returned?
Have you stepped through the Outlook_GetSignature function to validate if it is building up the variables properly, checking what is being returned, …?
Hi Daniel,
Great work, just what I need, Thanks!
One thing though the page looks out of order. The beginning section of the page doesn’t display what it ought to display, and the function itself has some problems in the usage part “My body.” which I don’t understand and would of course generate an error.
Can you please look into it.
Thanks
Sorry about that. I recently had to replace my syntax highlighter and now have a mess on my hands to clean up (over 800 post to fix!). Anyways, I believe I have corrected this one. Thank you for flagging the issue.
Much better Daniel.
Still one teeny whiny thing, the usage section with the attachments need an extra ‘,’ because they are now in the BCC parameter.
Thanks for the quick response.
After recent changes in Exchange / Outlook my code to send emails from access to Outlook (nearly similar to the one discussed here) has begun failling.
Messages appear as sent but immediately I received a messages like this:
Generating server: SYBP282MB0298.AUSP282.PROD.OUTLOOK.COM
*** Email address is removed for privacy ***
Remote Server returned ‘554 5.6.0 STOREDRV.Submit.Exception:CorruptDataException; Failed to process message due to a permanent exception with message [BeginDiagnosticData]Store ID ‘AAAAAAcLGny8FNxImzT0IVOsXLpkwiYA’ with type ‘Folder’ isn’t an ID of a folder, item or mailbox. CorruptDataException: Store ID ‘AAAAAAcLGny8FNxImzT0IVOsXLpkwiYA’ with type ‘Folder’ isn’t an ID of a folder, item or mailbox.[EndDiagnosticData]’…
And after a few days investigating I have found that now the .SendUsingAccount property of MailItem must be set (at least if you have more than one registered) otherwise it will not be able to deliver the message.
Previously if this property was not set Outlook used the “default” email account you set, but it seems that this no longer works, at least with exchange accounts.
Consequently, I think that the part of the code relating to the Optional vAccount variable should be modified so that it is no longer optional or so that if the parameter has not been passed, the code chooses the default account.
I am using Outlook 365 desktop version 2308 (build 16731.20234) and I am getting an error when Outlook is already open:
Error number: -2146959355
Error Source: SendHTMLEmail
Error Description: Server execution failed!
It has been working until a couple of month back, may have been caused by an Outlook update?
Any idea how to solve it?
No 100% sure, but if it was working and now suddenly doesn’t then it is either because of some Microsoft update or a change in Outlook configuration.
You’d need to debug the code and see where it’s failing to address the issue. Try adding line numbers, executing the code line by like until it triggers the error…
Hi
Your procedure, SendHTMLEmail, is properly the best I have ever seen! Thanks!
But I have a little issue with it:
When sending a email, I need some kind of feedback, (true or false), if the user has send the email via Outlook or not.
Almost like the vba function DoCmd.SendObject acSendNoObject, where it returns error 2501 if the user did not send the email.
Is that something you could help me with?
I have absolutely no idea how to do it myself.
Best regards
Peter