A recent client of mine wanted me to make some enhancements to an Access database. The enhancements were all aimed at reducing the workflow. One of the issues they were encountering was at the end of the workflow, the user clicked a button inside the Access database that opened a Word file. This Word file would then walk the user through doing a Mail Merge from within Word to get elements out of the database and then create e-mails in Microsoft Outlook.
The problem was there were quite a few steps involved and at the end of it all, the user had to go back into the database and wipe out some temp tables to be able to restart the process the next day. If they got up from their desk and then came back – it was pretty easy to forget where they were in the workflow and could miss steps.
The client wanted to know if there was a way to do the entire mail merge process inside Access so that everything was automated and the wouldn’t have to go out to Microsoft Word. Piecing together a bunch of different scripts online, I was able to duplicate their Word template as an HTML formatted email, generated from within Access with all the appropriate data elements included in the e-mail.
Here is the outline of the code I used – I have included comments to explain what different parts are doing in the code. If you have specific questions, please let me know in the comments below.
Enjoy!
Private Sub send_mail() 'Substantiate the script
'Create application and mail objects
Dim olApp As Object
Dim objMail As Object
'Create a query definition and set it to run a specific query.
'Change "Email Query" in square brackets to match query name in your database.
Dim qd As QueryDef
Set qd = CurrentDb.QueryDefs![Email Query]
'Create a record set and run the query defined above
Dim rst As Recordset
Set rst = qd.OpenRecordset()
'The following code loops through each record brought back by the query and
'creates an email for each record.
rst.MoveFirst
Do Until rst.EOF
strElement1 = rst![DataElement1]
strElement2 = rst![DataElement2]
rst.MoveNext
On Error Resume Next 'Keep going if there is an error
Set olApp = GetObject(, "Outlook.Application") 'See if Outlook is open
If Err Then 'Outlook is not open
Set olApp = CreateObject("Outlook.Application") 'Create a new instance
End If
'Create e-mail item
Set objMail = olApp.CreateItem(olMailItem)
With objMail
'Set body format to HTML
.BodyFormat = olFormatHTML
.To = "address@yourmailaddress.com"
'.Cc = "ccaddress@yourmailaddress.com"
Uncomment out above line to add a carbon copy e-mail address
'.Bc = "bcaddress@yourmailaddress.com"
Uncomment out above line to add a blind copy e-mail address
.Subject = "E-mail Message Subject Goes Here"
.HTMLBody = "<!DOCTYPE html>"
.HTMLBody = .HTMLBody & "<html><head><body>"
You can keep building out the html using the same syntax of adding .HTMLBody from the line above & tacking on whatever is new:
.HTMLBody = .HTMLBody & "<h1><u>This is an example header line</u></h1>"
.HTMLBody = .HTMLBody & "<h2><u>This is an example header 2 line</u></h2>"
.HTMLBody = .HTMLBody & "<table>"
.HTMLBody = .HTMLBody & "<tr><td>Element 1</td><td>"& strElement1 & "</td></tr>"
.HTMLBody = .HTMLBody & "<tr><td>Element 2</td><td>"& strElement2 &"</td></tr>"
.HTMLBody = .HTMLBody & "</table>"
.HTMLBody = .HTMLBody & "<br><br><img height=""20"" width=""684"" border=""0""
src=""C:\Users\USERNAME\Desktop\image001.png"" style=""width: 684px; height: 20px;""/img>"
Above is an example of adding in an image to the Email HTML
.HTMLBody = .HTMLBody & "<br><br>Email Customer Service at
<a href=""mailto:Support@youremailaddress.com"">Support@youremailaddress.com</a>"
Above is an example of adding a URL to the Email HTML
.HTMLBody = .HTMLBody & "<br>or call 1-800-YOUR NUMBER HERE (Mon – Fri, 8am - 8pm Eastern)."
.HTMLBody = .HTMLBody & "</body></html>"
By ucommentiong out the "Send" command below, emails will be sent out without allowing the user to review them first. Using the "Display" command brings up all the emails as draft emails and allows the user to review them prior to sending them.
'.send
.Display
End With
Loop
End Sub
Excellent Tips 