How to automate Access Query Results into Email via Outlook?

Posted on 2010-09-03
Last Modified: 2012-05-10
Using Access 2003 & Outlook 2003.

I have a simple database that I have a table with email addresses & user names that I want to use to generate an email in outlook from Access.  I seem to have that part working but have two other issues to deal with.

1. I have a query which it's results create a many to one relationship with the user who I want to email.  I'd like to create the email and have the body of the email contain the results of the query for only that user.

2. When Access creates the Outlook email based on my current code it launches the Outlook Security prompt for each email it creates.

I've done some research on both issues but I'm fairly a novice and I need to get this project moving any help is appreciated.  I'm attaching my current code.  The query I need to pull records into the body of the email is called "Event_Email".

Thanks for any assistance.


Public Function SendEmail()

Dim db As DAO.Database

Dim MailList As DAO.Recordset

'Events_Email will be the query showing current events

Dim Event_Email As DAO.Recordset

Dim MyOutlook As Outlook.Application

Dim MyMail As Outlook.MailItem

Dim SubjectLine As String

Dim MyBody As textstream

Dim MyBodyText As String

Dim MyNewBodyText As String

Dim StopRep As Variant

Dim strStopRep As String

Set MyOutlook = New Outlook.Application

Set MyMail = MyOutlook.CreateItem(olMailItem)

SubjectLine = "IMDL Event Log Report" & " " & Date

Set db = CurrentDb()

'Setting mail list to look at the Email Address table

Set MailList = db.OpenRecordset("Emailer_Address")

Set Event_Email = db.OpenRecordset("Event_Email")

Do Until MailList.EOF

'Set MyBody

MyBodyText = "test"

'may be missing link

Set MyMail = MyOutlook.CreateItem(olMailItem)

MyMail.To = MailList("Email")

MyMail.Subject = SubjectLine

MyMail.Body = MyBodyText




Set MyMail = Nothing

Set MyOutlook = Nothing


Set MailList = Nothing


Set db = Nothing

End Function

Open in new window

Question by:WEBEJOH
  • 3
  • 2
  • 2
  • +2
LVL 65

Expert Comment

ID: 33600630
Regarding the security prompt there are options like 3rd party s/w or rewrite code using redemption or outlook
or the tool that Patrick mentioned which looks neat (I need to look at it) MAPILab
LVL 16

Expert Comment

ID: 33600694
I think the sendobject method is better suited for what you want to achieve

Syntax is:

DoCmd.SendObject(ObjectType, ObjectName, OutputFormat, To, Cc, Bcc, Subject, MessageText, EditMessage, TemplateFile)

So your code becomes:

DoCmd.SendObject(acSendQuery, "QueryName, acFormatRTF, Me.EmailAddress, , , Subject)
LVL 74

Accepted Solution

Jeffrey Coachman earned 200 total points
ID: 33601670
<  I'd like to create the email and have the body of the email contain the results of the query for only that user.>


This will not be straightforward as:
1.  Do you want the data "Formatted"?
Remember the way that you normally view a query (Datasheet View) needs "Formatting" to appear the same way in the email body
So for that you can't use SendObject..
You have to use the code you posted substituting: .Body with: .htmlBody
2. Most email filtering programs will flag messages containing HTML in the message body as Spam, and immediately send them to the recipients Junkemal folder.
3. This will be "A LOT" easier if you used a filtered report instead of a query for formatting purposes and for emailing
4. I will presume that in the loop, you are looping each user and each user has an email address field.

Here is perhaps my hardest fought sample file.
It is brute force, but it works.

In order to run it you must:
Load a reference to the Microsoft Outlook Object Library in your VBA Editor.
Load a reference to the Microsoft Scripting runtime Library in your VBA Editor.
Load you own Email Address into each employee record, so as a test, all the emails go to you.

Again, this is very sloppy, but it does work!
If it works, I will promise to clean it up tomorrow for you.




LVL 74

Expert Comment

by:Jeffrey Coachman
ID: 33601672
The code is "Frankenstein-ed" together from at least 3 different snippets...
Zoho SalesIQ

Hassle-free live chat software re-imagined for business growth. 2 users, always free.

LVL 31

Assisted Solution

Helen_Feddema earned 50 total points
ID: 33603223
Here is some simple code to create an email for each contact in an Access recordset:
Public Sub EMailAllContacts()

'Created by Helen Feddema 31-Oct-2009

'Last modified by Helen Feddema 31-Oct-2009

On Error GoTo ErrorHandler

   Dim dbs As DAO.Database

   Dim rst As DAO.Recordset

   Dim appOutlook As Outlook.Application

   Dim msg As Outlook.MailItem

   Dim strEmail As String


   Set dbs = CurrentDb

   Set rst = dbs.OpenRecordset("qryContacts")

   Set appOutlook = GetObject(, "Outlook.Application")


   Do While Not rst.EOF

      strEmail = Nz(rst![EmailName])

      If strEmail <> "" Then

         'Create email

         Set msg = appOutlook.CreateItem(olMailItem)

         msg.To = strEmail

         msg.Subject = "Subject"

         msg.Body = "Message"


         'Comment out next line and uncomment Send line

         'to send automatically



      End If






   Set rst = Nothing

   Set appOutlook = Nothing

   Exit Sub


   'Outlook is not running; open Outlook with CreateObject

   If Err.Number = 429 Then

      Set appOutlook = CreateObject("Outlook.Application")

      Resume Next


      MsgBox "Error No: " & Err.Number _

         & " in EMailAllContacts procedure" _

         & "; Description: " & Err.Description

      Resume ErrorHandlerExit

   End If

End Sub

Open in new window

LVL 31

Expert Comment

ID: 33603230
To avoid the annoying security messages, use the Redemption Library and rewrite part of the code like this:

'Redemption objects and corresponding Outlook objects must

   'be declared as Object type

   Dim omsg As Object

   Dim msg As Object

   Dim otsk As Object

   Dim tsk As Object


      'Create new mail message and send it now

      Call OpenOutlook

      Set omsg = gappOutlook.CreateItem(olMailItem)

      Set msg = New Redemption.SafeMailItem

      msg.Item = omsg


      With msg

         .To = strToEMail

         .Subject = strMessageSubject

         .Body = strBody


      End With


      'Note:  Messages created with Redemption Library objects

      'are created in the Drafts folder instead of the Outbox,

      'but they will be sent as if from the Outbox.

Open in new window


Author Closing Comment

ID: 33618715
Thank you very much for your assistance.  This was my first question post and I'm supermely impressed with the responses and willingness to help out!

Author Comment

ID: 33618768
All of the responses were helpful and a special thanks to boag2000 and Helen for teaching me up to find the solutions that I needed.
LVL 74

Expert Comment

by:Jeffrey Coachman
ID: 33618998
No problem, I am glad we gave you a good first impression.



Featured Post

Control application downtime with dependency maps

Visualize the interdependencies between application components better with Applications Manager's automated application discovery and dependency mapping feature. Resolve performance issues faster by quickly isolating problematic components.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

If you don't know how to downgrade, my instructions below should be helpful.
Finding original email is quite difficult due to their duplicates. From this article, you will come to know why multiple duplicates of same emails appear and how to delete duplicate emails from Outlook securely and instantly while vital emails remai…
In Microsoft Access, learn different ways of passing a string value within a string argument. Also learn what a “Type Mis-match” error is about.
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

896 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now