Link to home
Create AccountLog in
Avatar of WEBEJOH
WEBEJOHFlag for United States of America

asked on

How to automate Access Query Results into Email via Outlook?

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.

John

john.weber@chrobinson.com

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

MyMail.Send

MailList.MoveNext

Loop

Set MyMail = Nothing

Set MyOutlook = Nothing

MailList.Close
Set MailList = Nothing
db.Close
Set db = Nothing

End Function

Open in new window

Avatar of rockiroads
rockiroads
Flag of United States of America image

Regarding the security prompt there are options like 3rd party s/w or rewrite code using redemption or outlook
https://www.experts-exchange.com/questions/26450355/VBA-to-eliminate-Microsoft-Outlook-s-dreaded-security-warnings.html
or the tool that Patrick mentioned which looks neat (I need to look at it) MAPILab
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)
ASKER CERTIFIED SOLUTION
Avatar of Jeffrey Coachman
Jeffrey Coachman
Flag of United States of America image

Link to home
membership
Create an account to see this answer
Signing up is free. No credit card required.
Create Account
The code is "Frankenstein-ed" together from at least 3 different snippets...
SOLUTION
Link to home
membership
Create an account to see this answer
Signing up is free. No credit card required.
Create Account
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
         .Send
      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

Avatar of WEBEJOH

ASKER

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!
Avatar of WEBEJOH

ASKER

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.
No problem, I am glad we gave you a good first impression.


;-)

Jeff