Building Microsoft Access Applications
This article is an excerpt from Building Microsoft Access Applications, from Microsoft Press (ISBN 0-7356-2039-3, copyright Microsoft Press 2005, all rights reserved). The author of the book is John Viescas.
John L. Viescas is the author of Microsoft Office Access 2003 Inside Out and the popular Running Microsoft Access books from Microsoft Press. He is president of Viescas Consulting, Inc., a respected provider of database application design and editorial consulting services. He has been recognized by Microsoft Product Support Services as a Most Valuable Professional (MVP) every year since 1993 for his contributions to the community of Access users.
No part of this chapter may be reproduced, stored in a retrieval system, or transmitted in any form or by any means—electronic;, electrostatic, mechanical, photocopying, recording, or otherwise—without; the prior written permission of the publisher, except in the case of brief quotations embodied in critical articles or reviews.
Chapter 8: Sending Out Notices
- Printing Notices
- Sending Notices by E-Mail
In the previous chapter, you learned techniques for tracking member status and dues payments and reporting members whose dues have expired. But you probably don't want to wait until a member shows up at the next meeting to try to collect dues. As you've worked with the Membership Tracking database, you've probably noticed that it's easy to enter meeting agendas and announcement information for each meeting. But you also want to be to be able to send notices to members in advance of each meeting—either; via regular mail or by e-mail. This chapter shows you how to solve both of these problems.
Printing Notices
Today many people have computers and e-mail addresses. But for some types of organizations, a large percentage of the membership might not have a computer or an e-mail address. So, any membership application needs a way to print out notices that can be mailed to members.
Printing Dues Expiration Letters
To construct a letter to send to members whose dues have expired or are about to expire, you need much of the same information that you gathered for the Dues Expiration report in Chapter 7, "Checking Member Status," in the qryRptDuesExpire query. Because you're mailing a letter, you don't need the phone numbers included in that report. Also, you should include a parameter that obtains a date value from a form specifically designed for sending out notices. You can find a query designed for this purpose, qryRptDuesExpireLetter, in the Membership sample database (Membership.mdb). The SQL for the query is as follows:
PARAMETERS [Forms]![fdlgNoticeChoices]![txtDate] DateTime;
tblMembers.MemberID, ([Title]+" ") & [FirstName] & " " & ([MiddleName]+" ") & [LastName]
& (", "+[Suffix]) AS MemberName, tblMembers.LastName, tblMembers.FirstName,
tblMembers.Nickname, NZ([NickName],[FirstName]) AS Salutation, tblMembers.MembershipStatus,
tlkpMembershipStatus.DuesComp, Choose([DefaultAddress],[WorkAddress],[HomeAddress]) AS
StreetAddr, Choose([DefaultAddress], [WorkCity] & ", " & [WorkStateOrProvince] & " " &
[WorkPostalCode],[HomeCity] & ", " & [HomeStateOrProvince] & " " & [HomePostalCode]) AS CSZ,
Replace(Mid([EmailName],InStr([EmailName],"MailTo:")+7),"#","") AS Email,
qryDuesExpire.PaidUntil, [Forms]![fdlgNoticeChoices]![txtDate] AS ExpireBy
FROM tlkpMembershipStatus
INNER JOIN (tblMembers
LEFT JOIN qryDuesExpire
ON tblMembers.MemberID = qryDuesExpire.MemberID)
ON tlkpMembershipStatus.MembershipStatus = tblMembers.MembershipStatus
WHERE (((tlkpMembershipStatus.DuesComp)=False) AND ((qryDuesExpire.PaidUntil) Is Null Or
(qryDuesExpire.PaidUntil)<[Forms]![fdlgNoticeChoices]![txtDate]));
Note You don't need the e-mail address to mail a dues expiration letter, but you'll see later that I use this same query to send the notices by e-mail.
Tip As you can see in the qryRptDuesExpireLetter query, the MemberName field concatenates the Title, FirstName, MiddleName, LastName, and Suffix fields and includes appropriate spacing and punctuation. However, many member records might not have a Title, MiddleName, or Suffix. In a string expression in Access, you can use either the & operator or the + operator to concatenate strings. The difference is the & operator ignores Null values and returns all the non-Null values concatenated together. The + operator, however, returns nothing if any part of the expression is Null—also; known as Null propagation. The expression for the MemberName field takes advantage of Null propagation provided by the + operator to eliminate the space after Title and MiddleName if either is Null and to eliminate the comma and space before Suffix if that is Null.
Remember that the qryDuesExpire query returns the latest dues expiration date for each member, but some members (such as those who have attended meetings only as a guest) might have never paid dues at all. This is why you must include not only records with an expiration date earlier than the parameter date but also records that have no expiration date (Is Null).
In each letter, it would also be nice to include a list of the current renewal options so that the member can choose a dues amount and related renewal extension length. You might remember from Chapter 7 that the qryCurrentDuesRates query returns the current rate for each different renewal interval. You can combine that query with the records from the qryDuesExpire query to calculate a new expiration date for each interval for each member. If the member has never paid dues, you can display an informative message about the expiration of any first-time payment of dues. You can find the qryRsubDuesExpireLetter query that fetches these rows in the Membership sample database. The SQL for the query is as follows:
SELECT qryDuesExpire.MemberID, [DuesInterval] & " months" AS [Renew For],
qryCurrentDuesRates.DuesAmt, NZ(DateAdd("m",[DuesInterval],[PaidUntil]),[DuesInterval] & "
months from date paid.") AS [Renew Until]
FROM qryDuesExpire, qryCurrentDuesRates
WHERE NZ(DateAdd("m",[DuesInterval],[PaidUntil]),Date())>=Date()
ORDER BY qryDuesExpire.MemberID, qryCurrentDuesRates.DuesInterval;
The query uses the DateAdd function to add the number of months specified in the DuesInterval field from the qryCurrentDuesRates query to the member's last expiration date. When the member has never paid dues, the DateAdd function returns a Null value. The NZ function examines that value, and if it is Null, substitutes a message that dues will expire [DuesInterval] months from the date the member first pays dues. The query also eliminates any rows where adding the renewal interval to the last paid until date would result in a date in the past.
Notice that there is no join specification in the From clause of this query. This query matches each row from the qryDuesExpire query with each row in the qryCurrentDuesRates query. You know that the qryDuesExpire query returns exactly one row per member, and the qryCurrentDuesRates query returns one row per available renewal interval. When you use this query as the record source for a subreport in a letter for each member, you can link the subreport on the MemberID field to display the renewal options pertinent for each member.
As with most reports, designing the query that the report needs is the hard part. The design of the rsubDuesExpireLetter report is quite simple. It displays the Renew For, DuesAmt, and Renew Until fields calculated by the qryRsubDuesExpireLetter query. Figure 8-1 shows you the design of this report that is embedded in the final report that produces the letter.
Figure 8-1. The rsubDuesExpireLetter report that is used to list dues renewal options for each member (Click picture to view larger image)
The report to print the letter (rptDuesExpireLetter) is fairly straightforward. Figure 8-2 shows you the design of this report.
The salutation line uses an expression that includes the Salutation field calculated in the query (use the Nickname field unless it is null; otherwise use the FirstName field). The expression is as follows:
="Dear " & [Salutation] & ":"
Code that executes when the report opens uses the qryCurrentTreasurer query to fetch the name of the member who is the treasurer as of the date you print the report. It also loads the two template messages stored in the ztblDuesMessages table (one for new members, and one for current members) into module variables. The SQL for the qryCurrentTreasurer query is as follows:
SELECT tblOfficers.OfficerType, tblOfficers.ServedTo, [FirstName] & " " & ([MiddleName]+" ")
& [LastName] & (", "+[Suffix]) AS MemberName
FROM tblMembers
INNER JOIN tblOfficers
ON tblMembers.MemberID = tblOfficers.MemberID
WHERE (((tblOfficers.OfficerType)="Treasurer") AND ((tblOfficers.ServedTo) Is Null Or
(tblOfficers.ServedTo)>=Date()));
Figure 8-2. The rptDuesExpireLetter report in Design view (Click picture to view larger image)
The Format event procedure for the Detail section creates the text of the letter and assigns that text to the unbound text box control at the top of the Detail section. This text box control has its Can Grow property set to Yes, so the text box expands to display all the text when you view or print the report. Code in that event procedure also inserts the treasurer name in the unbound text box that you see below the subreport control. The code in the Format event of the Detail section that inserts both the text of the letter and the treasurer name is as follows:
Option Compare Database
Option Explicit
' Place to save treasurer name in Open
Dim strTreasurer As String
' Place to save the new member message
Dim strNewMemberMsg As String
' Place to save the expired dues message
Dim strDuesExpireMsg As String
Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
Dim strExpire As String
' Set the treasurer name
Me.txtTreasurer = strTreasurer
' If a Guest or never paid dues
If (Me.MembershipStatus = "Guest") Or _
IsNull(Me.PaidUntil) Then
' Make letter an offer to join
Me.txtMsg = strNewMemberMsg
Else
' If already expired
If Me.PaidUntil < Date Then
' Set expired on
strExpire = "Your membership expired on " & _
Format(Me.PaidUntil, "mmmm d, yyyy")
Else
' Set will expire
strExpire = "Your membership expires on " & _
Format(Me.PaidUntil, "mmmm d, yyyy")
End If
' Set the message
Me.txtMsg = strExpire & ". " & strDuesExpireMsg
End If
End Sub
The module variables strTreasurer, strNewMemberMsg, and strDuesExpireMsg are set by code in the report Open event procedure. The code first opens a query that returns the current treasurer name based on today's date. The code then opens the ztblDuesMessages table that contains the text to be displayed for current and new members. Using a table in this way allows the user to modify the messages printed in the dues expiration report without having to change the report design. The code is as follows:
Private Sub Report_Open(Cancel As Integer)
Dim rst As DAO.Recordset
' Get the current Treasurer name
Set rst = DBEngine(0)(0).OpenRecordset("qryCurrentTreasurer")
If Not rst.EOF Then
strTreasurer = rst!MemberName
End If
' Close out
rst.Close
' Now open the template table
Set rst = DBEngine(0)(0).OpenRecordset("ztblDuesMessages")
' Process the rows
Do Until rst.EOF
' Decide which template we're loading
Select Case rst!Template
' New member
Case "New Member"
' Save the template
strNewMemberMsg = rst!TemplateText
' Existing member
Case "Current Member"
' Save the template
strDuesExpireMsg = rst!TemplateText
End Select
' Get the next row
rst.MoveNext
Loop
' Close out
rst.Close
Set rst = Nothing
End Sub
You can run this report by starting the application (open the frmSplash form) and clicking the Notices button on the main switchboard. The application opens the fdlgNoticeChoices form—remember;, this form is referenced in the record source of the report. Select Dues Expiration Notice, choose a date, select Print Notices, and click Go, as shown in Figure 8-3, to see the report.
Figure 8-3. Running the Dues Expiration Notice report
The code that responds to clicking the command button is simple. It examines the options you picked and either opens the appropriate report or calls a procedure to generate e-mails.
Printing Meeting Announcements
The Pacific Northwest Access Developers Group sends out regular notices about upcoming meetings. The group secretary will often include various special announcements as well as the actual agenda of the meeting. Some of these announcements should display or print before the agenda items (such as a notice about a meeting location change or special topic that should receive special attention), and some of the announcements should print after the agenda items at the end of the notice (such as a thank you to a sponsor who has provided door prizes).
You can see how the secretary enters agenda items and announcements for a meeting by opening the frmMeetings form in the Membership application. Figure 8-4 shows you the agenda items for one of the meetings, and Figure 8-5 shows you the announcements.
Note that the announcements subform lets the secretary specify whether the announcement is to appear before or after the agenda items. The Before / After combo box actually stores the number 0 for Before and the number 2 for After.
Figure 8-4. Entering agenda items for a meeting (Click picture to view larger image)
Figure 8-5. Entering announcements for a meeting (Click picture to view larger image)
To produce all the rows you need for a meeting announcement in the correct order, you can use a union query to select the before rows for announcements, the agenda items, and the after rows for announcements. To put the rows in the correct sequence, you can generate a number literal with a value of 1 to put the agenda rows in the middle. (Now you know why before announcements are 0 and after announcements are 2!) The query that performs this task is qryRptMeetingAnnouncement, and the SQL for the query is as shown here:
SELECT tblMeetings.MeetingID, tblMeetings.MeetingDate, tblMeetings.MeetingLocation,
tblMeetings.CommitteeName, tblMeetings.MeetingDescription,
tblMeetingAnnouncements.AnnounceNo, tblMeetingAnnouncements.AnnounceTitle,
tblMeetingAnnouncements.AnnounceDescription, tblMeetingAnnouncements.BeforeAfter
FROM tblMeetings
INNER JOIN tblMeetingAnnouncements
ON tblMeetings.MeetingID = tblMeetingAnnouncements.MeetingID
WHERE tblMeetingAnnouncements.BeforeAfter=0
UNION ALL
SELECT tblMeetings.MeetingID, tblMeetings.MeetingDate, tblMeetings.MeetingLocation,
tblMeetings.CommitteeName, tblMeetings.MeetingDescription, tblMeetingAgenda.TopicNo,
tblMeetingAgenda.TopicTitle, tblMeetingAgenda.TopicDescription, 1 AS BeforeAfter
FROM tblMeetings
INNER JOIN tblMeetingAgenda
ON tblMeetings.MeetingID = tblMeetingAgenda.MeetingID
UNION ALL
SELECT tblMeetings.MeetingID, tblMeetings.MeetingDate, tblMeetings.MeetingLocation,
tblMeetings.CommitteeName, tblMeetings.MeetingDescription,
tblMeetingAnnouncements.AnnounceNo, tblMeetingAnnouncements.AnnounceTitle,
tblMeetingAnnouncements.AnnounceDescription, tblMeetingAnnouncements.BeforeAfter
FROM tblMeetings
INNER JOIN tblMeetingAnnouncements
ON tblMeetings.MeetingID = tblMeetingAnnouncements.MeetingID
WHERE tblMeetingAnnouncements.BeforeAfter=2
ORDER BY MeetingID, BeforeAfter, AnnounceNo;
Note You might be tempted to create a report that uses a query on the tblMeetings table and uses subreports for the records from the tblMeetingAgenda table and the tblMeeting-Announcements table. However, when a subreport generates more data rows than will fit on a page, producing headers at the top of subsequent pages will be difficult. It's much easier to create a single recordset that joins the tblMeetings table with either the tblMeetingAgenda table or the tblMeetingAnnouncements table and not use subreports.
Because all the work is done by the query, the report layout is simple. Figure 8-6 shows you the design of the rptMeetingAnnouncement report.
The MeetingID Header section has the Force New Page property set to Before Section, and the Repeat Section property set to Yes. The AnnounceNo Header section also has its Repeat Section property set to Yes so that all the details of the meeting and the title of each topic will print again at the top of a new page when the announcement or agenda item description overflows a page.
You can print a meeting announcement either by clicking the Notices button on the main switchboard or by opening the meeting you want and clicking the Print/Send button (as shown in Figure 8-4) on the Meetings form. In either case, you'll see the fdlgNoticeChoices form shown earlier in Figure 8-3, but you'll also see a combo box to select the meeting to print when you select the Meeting Notice option. Figure 8-7 shows you the first part of the announcement for the October 2004 general meeting.
Figure 8-6. The design of the rptMeetingAnnouncement report (Click picture to view larger image)
Figure 8-7. The Meeting Announcement report (Click picture to view larger image)
Sending Notices by E-Mail
You might think that mailing notices is old technology in this modern era of the Internet and e-mail, and you might be right. The good news is that designing the two reports to send out dues expiration notices and meeting announcements has laid the groundwork for creating e-mails that serve the same function.
To make your e-mails look their best, you should format them as HTML so that you can use various fonts and include graphics. You could painstakingly write the HTML code you need in the procedure that formats and sends your e-mails. Or, you could use an HTML editor such as Microsoft FrontPage to design a template and then store the pieces of the template you need in a table. I chose the latter method, and you can find the parts of the templates used in the next two sections saved in the ztblHTMLTemplates table.
Sending Dues Expiration Notices by E-Mail
Because I decided to use templates to build the HTML, I first built a sample Web page for the dues expiration messages. You can find this template file in the sample files saved as DuesExpireTemplate.html. Figure 8-8 shows you the template displayed in Microsoft Internet Explorer.
Figure 8-8. The template for dues expiration e-mail messages (Click picture to view larger image)
You can see that I embedded keywords in the HTML ([Today], [Nickname], [ExpireMsg], and so on) to make it easy to customize each message. You can find the template broken into three pieces as records in the ztblHTMLTemplates table—the; top part of the message including the Nickname and ExpireMsg keywords, the renewal option line that might appear several times, and the signature lines.
You can try this out by starting the application (open the frmSplash form), clicking Notices on the main switchboard, selecting Dues Expiration Notice in the Notification Choices dialog box, selecting an expiration date, selecting the option to Email Notices (the default), and clicking the Go button. You might see several e-mails generated, but unless you've entered dues payments to bring all members up to date, you should see at least one. Because all the e-mail addresses in the database are fictitious, the code in the application merely displays the e-mail messages rather than sending them. Figure 8-9 shows you a formatted message.
Figure 8-9. An e-mail sent by the dues expired notification procedure (Click picture to view larger image)
Although I set up template records in advance to make assembling the e-mail message easier, the code that performs this task in the fdlgNoticeChoices form isn't simple at all. The code is in the DuesEmail function in the form's module, and that function is called from the procedure that responds to clicking the Go button when you select the Dues Expiration Notice and Email Notices options. The first part of the function gets the current treasurer's name and the two different dues messages—similar; to the code in the rptDuesExpireLetter report you saw earlier. It borrows the query for that report to find out all the members whose dues expire by the date specified on the form. Note that to open a parameter query in code, you must first open the QueryDef object, set the parameter, and then open a recordset on the QueryDef. When the code finds no members with dues expiring by the specified date, it displays a message and exits. The code is as follows:
Private Function DuesEmail() As Integer
Dim db As DAO.Database, qd As DAO.QueryDef, rstRenew 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, strTreasurerName As String
' Set an error trap
On Error GoTo DuesEmail_Err
' Point to this database
Set db = DBEngine(0)(0)
' Get the current Treasurer name
Set rstData = db.OpenRecordset("qryCurrentTreasurer")
If Not rstData.EOF Then
strTreasurerName = rstData!MemberName
End If
' Close out
rstData.Close
' Now open the dues messages table
Set rstData = db.OpenRecordset("ztblDuesMessages")
' Process the rows
Do Until rstData.EOF
' Decide which template we're loading
Select Case rstData!Template
' New member
Case "New Member"
' Save the template
strNewMemberMsg = rstData!TemplateText
' Existing member
Case "Current Member"
' Save the template
strDuesExpireMsg = rstData!TemplateText
End Select
' Get the next row
rstData.MoveNext
Loop
' Close out
rstData.Close
' Get the query that the report uses
Set qd = db.QueryDefs("qryRptDuesExpireLetter")
' Set its parameter
qd.Parameters(0) = Me.txtDate
' Open the recordset
Set rstData = qd.OpenRecordset
' See if any records
If rstData.RecordCount = 0 Then
' Tell the user
MsgBox "No member dues expire before the date you specified.", _
vbInformation, gstrAppTitle
' Close out
rstData.Close
Set rstData = Nothing
Set qd = Nothing
Set db = Nothing
' Bail
Exit Function
End If
Next, the code opens the HTML template records for the dues expiration notice. This code expects the template to be broken into three parts:
- A header with the logo, address, date, person name, message body, and the heading of the dues renewal table.
- The dues renewal line, which the code might use multiple times.
- The footer that contains the treasurer name.
The code processes each member's dues expiration record (for members whose dues expire by the date you specified) by fetching the first part of the template and filling in the date, person name, and expiration message. Notice that the Replace function works well to find the template keywords and replace them with the actual text. The code is as follows:
' Open the HTML template for email
Set rstTemplate = db.OpenRecordset( _
"SELECT * FROM ztblHTMLTemplates " & _
"WHERE Template = 'Dues' " & _
"ORDER By TemplateSeq")
' Process the members one at a time
Do Until rstData.EOF
' Make sure we're at the start of the template records
rstTemplate.MoveFirst
' Grab the first part
strWork = rstTemplate!TemplateHTML
' Put in today's date
strWork = Replace(strWork, "[Today]", Format(Date, "mmmm d, yyyy"))
' Put in the person's first name or nickname
strWork = Replace(strWork, "[Nickname]", rstData!Salutation)
' If a Guest or never paid dues
If (rstData!MembershipStatus = "Guest") Or _
IsNull(rstData!PaidUntil) Then
' Make letter an offer to join
strMsg = strNewMemberMsg
Else
' If already expired
If rstData!PaidUntil < Date Then
' Set expired on
strExpire = "Your membership expired on " & _
Format(rstData!PaidUntil, "mmmm d, yyyy")
Else
' Set will expire
strExpire = "Your membership expires on " & _
Format(rstData!PaidUntil, "mmmm d, yyyy")
End If
' Set the message
strMsg = strExpire & ". " & strDuesExpireMsg
End If
' Replace the message in the HTML
strWork = Replace(strWork, "[ExpireMsg]", strMsg)
' Stuff what we have so far in the HTML variable
strHTML = strWork
Next, the code gets the second part of the template to fill in the renewal option lines. The code opens the renewal options recordset for this member, using the same query that is also the record source for the rsubDuesExpireLetter subreport. Using the template, it fills in the Renew For, Dues, and Renew Until values and adds each row one at a time to the HTML built to this point. The code is as follows:
' Move to the next template row
rstTemplate.MoveNext
' Open a recordset on the renew options for this person
Set rstRenew = db.OpenRecordset("SELECT * FROM " & _
"qryRsubDuesExpireLetter " & _
"WHERE MemberID = " & rstData!MemberID)
' Loop and insert the options
Do Until rstRenew.EOF
' Get the template for the expire option rows
strWork = rstTemplate!TemplateHTML
' Put in Renew For months
strWork = Replace(strWork, "[RenewFor]", rstRenew![Renew For])
' Put in Dues
strWork = Replace(strWork, "[Dues]", _
Format(rstRenew!DuesAmt, "Currency"))
' Put in new expire date
strWork = Replace(strWork, "[RenewUntil]", rstRenew![Renew Until])
' Add to the HTML
strHTML = strHTML & strWork
' Get the next renewal option
rstRenew.MoveNext
Loop
' Close the renewal recordset
rstRenew.Close
Set rstRenew = Nothing
Finally, the code gets the last part of the template for this member's message, fills in the treasurer name, and calls the SendOutlookMsg function to send the message on its way. The code is as follows:
' Get the last piece of the template
rstTemplate.MoveNext
' Get the HTML
strWork = rstTemplate!TemplateHTML
' "sign" the letter
strWork = Replace(strWork, "[Treasurer]", strTreasurerName)
' Finish the HTML
strHTML = strHTML & strWork
' Send the email
If Not (SendOutlookMsg("Notice of Dues Expiration", _
rstData!FirstName & " " & rstData!LastName & _
"<" & rstData!Email & ">", strHTML)) Then
' Got failure - tell the user
MsgBox "Notice to " & rstData!FirstName & " " & _
rstData!LastName & " failed.", vbCritical, gstrAppTitle
End If
' Move to the next member record
rstData.MoveNext
Loop
' Close the member data and template
rstData.Close
Set rstData = Nothing
rstTemplate.Close
Set rstTemplate = Nothing
Set qd = Nothing
Set db = Nothing
' All worked - return success
DuesEmail = True
DuesEmail_Exit:
Exit Function
DuesEmail_Err:
' Tell user about an error
MsgBox "Unexpected error: " & Err & ", " & Error, _
vbCritical, gstrAppTitle
' Bail
Resume DuesEmail_Exit Function
End Function
You can find the code for the SendOutlookMsg function in the modOutlook module. If you look at the references for the Membership project (open the Visual Basic Editor and choose References from the Tools menu), you'll find that I did not include a reference to the Outlook library. I did this so you can run this application on any machine that has Microsoft Outlook 2000, 2002, or 2003 installed. If I referenced a specific library, none of the code would run on a machine that had another version installed because the project would have a library reference error.
To make this code work, I used a coding technique called late binding. Rather than declare objects from the Outlook library, I declared the objects I need simply As Object. The code uses the CreateObject function to start a copy of Outlook and get a reference to its Application object. The code then uses the CreateItem method of the Application object to create a new e-mail message, set its Subject property, the To or BCC property, and the HTMLBody property using the parameters passed to the function. Finally, the code executes the Display method to show you the result. The code is as follows:
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
' Display it
objMail.Display
' 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
Tip If you look carefully at the templates I created for the HTML code builds, you'll notice that the code embeds the logo by making a reference to a graphics file on my Web site. The HTML code is as follows:
<img src="http://www.viescas.com/PNWADGLogoSmall.gif" width="89" height="94">
Although you can include an image directly in an HTML format e-mail message from the user interface and send the graphic embedded in the message, doing so from code is extremely tricky. You must first add the graphic as an attachment and then establish a Messaging Application Programming Interface (MAPI) session for the mail item so that you can change the attributes of the attachment to mark it embedded and create the Content ID (CID) you need to be able to reference the image within your HTML. Unfortunately, some of the methods you must use in the MAPI session are undocumented, and I'm always loath to recommend such techniques. You can read more about this technique at fellow Outlook MVP Sue Mosher's Web site: http://www.outlookcode.com/d/code/htmlimg.htm.
Sending a Meeting Announcement by E-Mail
As you might suspect, I also used an HTML template to construct a meeting announcement. You can find this template file saved as MeetingAnnouncement-Template.html in the sample files. Figure 8-10 shows you the template displayed in Microsoft Internet Explorer.
You can see that I embedded keywords in the HTML ([MeetingDate], [Committee], [MeetingDescription], and so on) to make it easy to customize the message. You can try this out by opening the frmMeetings form, selecting one of the general meetings (they are more interesting), clicking the Print/Send button, and clicking the Go button in the Notification Choices dialog box. As noted earlier, because all the e-mail addresses in the database are fictitious, the code in the application merely displays the e-mail message rather than sending it. For meetings, the code also places the e-mail addresses on the Bcc line of the message. Figure 8-11 shows you a formatted meeting announcement. You can click on any of the topic lines to jump to that topic or announcement because the code generates internal hyperlinks to bookmarks.
Figure 8-10. The template for meeting announcement messages (Click picture to view larger image)
Figure 8-11. A meeting notice ready to send via e-mail (Click picture to view larger image)
In some ways, the code to assemble this message is somewhat less complex because it has to generate only one message to multiple recipients. However, the code to assemble the topic index and the topics is trickier. You can find the code in the AnnouncementEmail function in the code module for the fdlgNoticeChoices form. The code begins by opening a recordset on the same union query used by the rptMeetingAnnouncement report, but filtered for the MeetingID that you selected on the form. If the recordset contains no records, the code tells the user and exits. The code is as follows:
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
Next, the code assembles a list of recipients. If the meeting is for a committee, the code uses the qryAnnounceEmailCommittee query to fetch the current members of the committee. If the meeting is a general meeting, the code uses the qryAnnounceEmail query to get a list of all members except those with Inactive status. The code is as follows:
' 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
Next, the code opens the HTML template records for the meeting announcement. This code expects the template to be broken into four parts:
- A header with the logo, meeting date and time, committee name, meeting description, meeting location, and the header of the topics list.
- The topics index line.
- The topic title and full description, which the code uses once per topic.
- The footer to close out the HTML.
The code gets the header and replaces all the relevant template marker fields with the data from the first row in the announcement recordset. The code is as follows:
' 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
Next, the code gets the topic index and topic detail templates. It then loops through all the topics in the announcement recordset, adding a line to the topic index (which will appear in a block at the beginning of the message), and a block to the topic body for each row (which all appear after the topic index block). As it adds each topic, it increments a topic number counter so that it can set up unique bookmarks and hyperlinks within the HTML. The code is as follows:
' 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
Finally, the code assembles the pieces of the message and calls the SendOutlookMsg function to send the message. The code is as follows:
' Got the pieces built, now assemble them
strHTML = strHTML & strTopics & strBody & strFootTemp
' Send the email
If Not (SendOutlookMsg("PNWADG - " & 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
This concludes the review of features specific to the Membership Tracking application. As you explore the forms and reports in the application, you're likely to discover additional interesting features that you can use in any application. You can find some of these features described in Appendix E, "Implementing Generic Features."