ACCESS FEED: RE: [MS_AccessPros] Sending Mail

Youssef-

I built a little routine to send email via Outlook that looks like:

----------------------------------------------------------

Option Compare Database

Option Explicit

Const olMailItem = 0

Public Function SendOutlookMsg(strSubject As String, strTo As String, _

strHTML As String, Optional intUseBCC As Integer = 0) As Integer

' Function to send an email message using Outlook

' Inputs: Subject of the message

' List of valid "To" email addresses

' HTML for the body of the message

' Send using BCC flag (optional)

' Output: True if successful

' Note: This demo version only formats and displays a new

' message. Use ObjMail.Send instead of .Display

' to actually send the message

Dim objOL As Object, objMail As Object

' Set an error trap

On Error GoTo SendOutlookMsg_Err

' Get a pointer to Outlook - late binding

Set objOL = CreateObject("Outlook.Application")

' Create a new email

Set objMail = objOL.CreateItem(olMailItem)

' Set the subject

objMail.Subject = strSubject

' Set To or BCC

If intUseBCC = True Then

objMail.BCC = strTo

Else

objMail.To = strTo

End If

' Insert the HTML of the message

objMail.HTMLBody = strHTML

' Send it

objMail.Send

' Done - clear objects

Set objMail = Nothing

Set objOL = Nothing

' Return true

SendOutlookMsg = True

SendOutlookMsg_Exit:

Exit Function

SendOutlookMsg_Err:

' Log the error

ErrorLog "SendOutlookMsg", Err, Error

' Bail

Resume SendOutlookMsg_Exit

End Function

-------------------------------------------------

Note that you do not need a reference to the Outlook library to run this
code because I'm using late binding and have declared the on constant that I
use.

The trick is the code expects HTML for the body of your message. You can
write some additional code to open a Recordset on your data and build the
HTML. It is much easier to do if you build HTML templates first and just do
a Replace in your code.

For example, I have a template to send meeting announcements that consists
of a header, index line, topic line, and footer. The four parts look like
this:

Heading:

<HTML>

<HEAD>

<META HTTP-EQUIV="Content-Type" CONTENT="text/html;charset=windows-1252">

<TITLE>Membership - Meeting Announcement</TITLE>

</HEAD>

<BODY>



<table border=0 cellpadding=0 cellspacing=0 width="714">

<tr>

<td width="320">[MeetingDate]</td>

<td width="391">

[Committee]</td>

</tr>

</table>

[MeetingDescription] 

[MeetingLocation]

 

<a
name="Top">Topics</a> 



Index:

<a
href="#[TopicKey]">[AnnounceTitle]</a> 

Topic:

 



<a name="[TopicKey]">[AnnounceTitle]</a> 



<a href="#Top" style="color: blue">(return top)</a>

Footer:



</BODY>

</HTML>

The following code grabs the data for a meeting announcement, builds a "to"
list from all members who are to attend the meeting, then bulds the HTML
using the above templates by reading in all the meeting topics and using
Replace to edit certain fields in the HTML before sending the fully
constructed string to the email function.

----------------------------------------------------------
---

Private Function AnnouncementEmail() As Integer

Dim db As DAO.Database, rstAnnounce As DAO.Recordset

Dim rstTemplate As DAO.Recordset, rstData As DAO.Recordset

Dim strTo As String, strTitle As String, strHTML As String

Dim strWork As String, strBody As String, strTopics As String

Dim strTopicIndexTemp As String, strTopicTemp As String, strFootTemp As
String

Dim intTopicNo As Integer, datMtgDate As Date

' Set an error trap

On Error GoTo AnnounceEmail_Err

' Point to this database

Set db = DBEngine(0)(0)

' Open the query that the report uses

' -- filtered on the meeting selected

Set rstAnnounce = db.OpenRecordset("SELECT * " & _

"FROM qryRptMeetingAnnouncement WHERE MeetingID = " & Me.cmbMeeting)

' See if any records

If rstAnnounce.RecordCount = 0 Then

' Tell the user

MsgBox "The meeting you selected has no announcement or agenda
records.", _

vbInformation, gstrAppTitle

' Close out

rstAnnounce.Close

Set rstAnnounce = Nothing

Set db = Nothing

' Bail

Exit Function

End If

' Get the list of members

' If a committee meeting,

If Not IsNothing(rstAnnounce!CommitteeName) Then

' Get the list of members on this committee

Set rstData = db.OpenRecordset( _

"SELECT * FROM qryAnnounceEmailCommittee " & _

"WHERE CommitteeName = '" & rstAnnounce!CommitteeName & _

"' AND ((DateLeft Is Null) Or (DateLeft > #" & _

rstAnnounce!MeetingDate & "#))")

' Make sure we have some

If rstData.RecordCount = 0 Then

' Ask if they want to send to entire list or bail

If vbYes = MsgBox("There are no members currently assigned " & _

"to the " & rstAnnounce!CommitteeName & " Committee. Do you
" & _

"want to send an announcement to all members?", _

vbQuestion + vbYesNo + vbDefaultButton2, gstrAppTitle) Then

' Close this one

rstData.Close

' Open for all members

Set rstData = db.OpenRecordset("qryAnnounceEmail")

Else

' Close out

rstData.Close

Set rstData = Nothing

rstAnnounce.Close

Set rstAnnounce = Nothing

Set db = Nothing

' Bail

Exit Function

End If

End If

Else

' Open a recordset on all active members

Set rstData = db.OpenRecordset("qryAnnounceEmail")

End If

' Build the "To" list

Do Until rstData.EOF

' Add an email name

strTo = strTo & rstData!FirstName & " " & _

rstData!LastName & _

"<" & rstData!Email & ">" & ";"

' Get the next record

rstData.MoveNext

Loop

' Close the recordset

rstData.Close

Set rstData = Nothing

' Open the HTML template for email

Set rstTemplate = db.OpenRecordset( _

"SELECT * FROM ztblHTMLTemplates " & _

"WHERE Template = 'Announcement' " & _

"ORDER By TemplateSeq")

' The first record has the header - copy it

strHTML = rstTemplate!TemplateHTML

' Insert the date

strHTML = Replace(strHTML, "[MeetingDate]", _

Format(rstAnnounce!MeetingDate, "mmmm dd, yyyy h:nnampm"))

' Insert the Committee, if any

strHTML = Replace(strHTML, "[Committee]", _

Nz(("Committee: " + rstAnnounce!CommitteeName), ""))

' Add the meeting description

strHTML = Replace(strHTML, "[MeetingDescription]", _

rstAnnounce!MeetingDescription)

' Finally, do the location

strHTML = Replace(strHTML, "[MeetingLocation]", _

rstAnnounce!MeetingLocation)

' Save the meeting date

datMtgDate = rstAnnounce!MeetingDate

' Load the rest of the template text

rstTemplate.MoveNext

' Record 2 is the Topic Index Template

strTopicIndexTemp = rstTemplate!TemplateHTML

rstTemplate.MoveNext

' Record 3 is the Topic Detail Template

strTopicTemp = rstTemplate!TemplateHTML

rstTemplate.MoveNext

' Record 4 is the footer

strFootTemp = rstTemplate!TemplateHTML

' Close the template recordset

rstTemplate.Close

Set rstTemplate = Nothing

' Now process all the topics, building indexes as we go

Do Until rstAnnounce.EOF

' Build the index first - add 1 to counter

intTopicNo = intTopicNo + 1

' Get the index template - insert the link key

strWork = Replace(strTopicIndexTemp, "[TopicKey]", _

"Topic" & intTopicNo)

' Insert the Topic Title

strWork = Replace(strWork, "[AnnounceTitle]", _

rstAnnounce!AnnounceTitle)

' Add it to the existing topics

strTopics = strTopics & strWork

' Now, do the topic body - insert link key

strWork = Replace(strTopicTemp, "[TopicKey]", _

"Topic" & intTopicNo)

' Insert the Topic Title

strWork = Replace(strWork, "[AnnounceTitle]", _

rstAnnounce!AnnounceTitle)

' Insert the topic detailed description

strWork = Replace(strWork, "[AnnounceDescription]", _

rstAnnounce!AnnounceDescription)

' Add it to the existing topic body

strBody = strBody & strWork

' Get the next record

rstAnnounce.MoveNext

Loop

' Close the recordset

rstAnnounce.Close

Set rstAnnounce = Nothing

Set db = Nothing

' Got the pieces built, now assemble them

strHTML = strHTML & strTopics & strBody & strFootTemp

' Send the email

If Not (SendOutlookMsg("Meeting Notice - " & Format(datMtgDate, "Long
Date") & _

" Meeting Announcement", _

strTo, strHTML, True)) Then

' Got failure - tell the user

MsgBox "Sending meeting notice failed.", vbCritical, gstrAppTitle

End If

' All worked - return success

AnnouncementEmail = True

AnnounceEmail_Exit:

Exit Function

AnnounceEmail_Err:

' Tell user about an error

MsgBox "Unexpected error: " & Err & ", " & Error, _

vbCritical, gstrAppTitle

' Bail

Resume AnnounceEmail_Exit

End Function

--------------------------------------------------------

I realize that's a lot to absorb to get the job done, but the result will be
quite nice. If you don't want to go to the trouble of building HTML
(recommended for building tables containing data), you can change the
message send code to set objMail.Body with plain text instead.

John Viescas, Author

Microsoft Access 2010 Inside Out

Microsoft Access 2007 Inside Out

Microsoft Access 2003 Inside Out

Building Microsoft Access Applications

SQL Queries for Mere Mortals

http://www.viescas.com/

(Paris, France)

From: MS_Access_Professionals@yahoogroups.com
[mailto:MS_Access_Professionals@yahoogroups.com] On Behalf Of Youssef
Sent: Sunday, March 24, 2013 8:09 AM
To: MS_Access_Professionals@yahoogroups.com
Subject: [MS_AccessPros] Sending Mail

Hi All,

i can send the mail with attached report from Access 2007.
but
i want to know how to send the data NOT in an attached report but INSIDE
mail BODY itself.

thanks in advance

[Non-text portions of this message have been removed]