Creating Emails from an Access Table

If you have an Access table (say, of customer, client, or contact information) with email addresses, you can create emails to people in the table directly from an Access form, so you don't need to open Outlook to create an email, which can save time. tblContacts in the sample database has an Email field with the contacts email address, and the form frmEMail (Figure 4.7) lets you send emails to contacts selected from a multi-select ListBox.

FIGURE 4.7

A form for selecting contacts as email recipients.

FIGURE 4.7

A form for selecting contacts as email recipients.

Two buttons let you quickly select (or deselect) all the contacts; once you have selected the email recipients, and entered the message subject and body, you can click the Create Email Messages button to create the set of emails and open them for review before sending. A set of email messages is shown in Figure 4.8.

FIGURE 4.8

A set of email messages created from an Access form.

FIGURE 4.8

A set of email messages created from an Access form.

The code that creates the email messages (and also the code that selects or deselects ListBox items) is listed here:

Private Sub cmdMergetoEMailMulti_Click()

On Error GoTo ErrorHandler

Set lst = Me![lstSelectContacts]

Check that at least one contact has been selected:

If lst.ItemsSelected.Count = 0 Then

MsgBox "Please select at least one contact" lst.SetFocus GoTo ErrorHandlerExit End If

Test for required fields, and exit if any are empty:

strSubject = Me![txtSubject].Value If strSubject = "" Then

MsgBox "Please enter a subject" Me![txtSubject].SetFocus GoTo ErrorHandlerExit End If strBody = Me![txtBody].Value If strBody = "" Then

MsgBox "Please enter a message body" Me![txtBody].SetFocus GoTo ErrorHandlerExit End If

For Each varltem In lst.ItemsSelected

Check for email address:

strEMailRecipient = Nz(lst.Column(1, varItem)) Debug.Print "EMail address: " & strEMailRecipient If strEMailRecipient = "" Then

GoTo NextContact End If

Create new mail message and send to the current contact:

Set appOutlook = GetObject(, "Outlook.Application") Set msg = appOutlook.CreateItem(olMailItem) With msg

.To = strEMailRecipient .Subject = strSubject .Body = strBody .Display End With

NextContact:

Next varItem

ErrorHandlerExit:

Set appOutlook = Nothing Exit Sub

ErrorHandler:

Outlook is not running; open Outlook with CreateObject:

If Err.Number = 429 Then

Set appOutlook = CreateObject("Outlook.Application")

Resume Next Else

& "; Description: " & Err.Description Resume ErrorHandlerExit End If

End Sub

Private Sub cmdSelectAll_Click() On Error GoTo ErrorHandler

Set lst = Me![lstSelectContacts]

lngListCount = Me![lstSelectContacts].ListCount

For lngCount = 0 To lngListCount lst.Selected(lngCount) = True Next lngCount

ErrorHandlerExit: Exit Sub

ErrorHandler:

MsgBox "Error No: " & Err.Number & "; Description: "

& Err.Description Resume ErrorHandlerExit

End Sub

Private Sub cmdDeselectAll_Click() On Error GoTo ErrorHandler

Set lst = Me![lstSelectContacts]

lngListCount = Me![lstSelectContacts].ListCount

For lngCount = 0 To lngListCount lst.Selected(lngCount) = False Next lngCount

ErrorHandlerExit: Exit Sub

ErrorHandler:

MsgBox "Error No: " & Err.Number & "; Description: "

& Err.Description Resume ErrorHandlerExit

End Sub

If you prefer to send the email messages automatically (without reviewing them), replace the .Display line in the code with .Send.

0 0

Post a comment