By Helen Feddema
Access versions: 2007-2013
Level: Intermediate
Access Archon #240:
Introduction
In a database (like the sample Northwind database) that records orders, you might want a quick and easy way to send order lists to customers. This article demonstrates how to send order lists to customers in both Plain Text and HTML format emails.
The Main Menu
The sample database for this article, Emailing Orders to Customers.accdb, has a New Style Main Menu (see Access Archon #212 for more details on this type of menu), with a large button for opening the main form, a selector for opening other forms, and a group of controls used to filter order records for emailing order lists:
Figure A. The main menu of the sample database, with controls for filtering order lists
The Start Date control’s row source is the OrderDate field in tblOrders, and once you select a date from this combo box, the End Date combo box’s row source is filtered for dates equal to or later than the selected start date. This method is preferable to letting users enter any dates, since it prevents the selection of date ranges with no orders.
The Select Customer control lets you select a customer from tblCustomers, using a filter to select only customers with orders, and applying a date range filter if a date range has been selected. There is also an [All] selection so users can explicitly select all customers. For both the date range and customer filters, if no filter value is selected, all dates (or all customers) are selected.
The option group at the bottom of the main menu offers a selection of Plain Text (the default selection) or HTML for the mail message format; when you click the Email Orders to Customers button, one of two procedures runs to create and open (but not send) emails to a customer, or to all customers. The two procedures are listed below:
Public Sub EmailPlainText(strSelectedCustomerID As String)
On Error GoTo ErrorHandler
Dim appOutlook As New Outlook.Application
Debug.Print "Selected Customer ID: " & strSelectedCustomerID
If strSelectedCustomerID = "ALL" Then
'Create emails for all customers
Set rstCustomers = CurrentDb.OpenRecordset("tblCustomers")
strQueryOrders = "qrySelectedOrders"
Do While Not rstCustomers.EOF
'Create filtered recordset of orders for this customer
strEMail = Nz(rstCustomers![Email])
strCompany = Nz(rstCustomers![CompanyName])
strSubject = "Orders for " & strCompany
strCustomerID = Nz(rstCustomers![CustomerID])
If strCustomerID <> "" Then
strSQL = "SELECT * FROM qryOrdersWithDetailsDateRange WHERE " _
& "[CustomerID] = " & Chr(39) & strCustomerID & Chr(39) & ";"
End If
Debug.Print "SQL for " & strQueryOrders & ": " & strSQL
lngCount = CreateAndTestQuery(strQueryOrders, strSQL)
Debug.Print "No. of items found: " & lngCount
If lngCount = 0 Then
GoTo NextCustomer
Else
'Create email for this customer
Set msg = appOutlook.CreateItem(olMailItem)
msg.To = strEMail
msg.Subject = strSubject
'Create header line
strHeader = "Order Date" & " " & "Quantity" _
& " " & "ProductName"
strBody = strHeader & vbCrLf & vbCrLf
'Put orders data into body of email
Set rstOrders = CurrentDb.OpenRecordset(strQueryOrders)
'Debug.Print "Processing orders for " & strCompany
Do While Not rstOrders.EOF
dteOrder = Nz(rstOrders![OrderDate])
strItem = Nz(rstOrders![ProductName])
lngQuantity = Nz(rstOrders![Quantity])
strQuantity = FormatNo(lngQuantity)
'Create line of body text
strLine = Format(dteOrder, "mm/dd/yyyy") & " " _
& strQuantity & " " & strItem
'Debug.Print "Line text: " & strLine
strBody = strBody & strLine & vbCrLf
rstOrders.MoveNext
Loop
msg.body = strBody
msg.Display
End If
NextCustomer:
rstCustomers.MoveNext
Loop
Else
'Create email for selected customer
strSQL = "SELECT * FROM qryOrdersWithDetailsDateRange WHERE " _
& "[CustomerID] = " & Chr(39) & strSelectedCustomerID _
& Chr(39) & ";"
strQueryOrders = "qrySelectedOrders"
'Debug.Print "SQL for " & strQueryOrders & ": " & strSQL
lngCount = CreateAndTestQuery(strQueryOrders, strSQL)
'Debug.Print "No. of items found: " & lngCount
If lngCount = 0 Then
strPrompt = "No records found; canceling"
strTitle = "Canceling"
MsgBox strPrompt, vbOKOnly + vbCritical, strTitle
GoTo ErrorHandlerExit
Else
Set rstCustomer = CurrentDb.OpenRecordset(strQueryOrders)
strEMail = Nz(rstCustomer![Email])
strCompany = Nz(rstCustomer![CompanyName])
strSubject = "Orders for " & strCompany
'Create email for this customer
Set msg = appOutlook.CreateItem(olMailItem)
msg.To = strEMail
msg.Subject = strSubject
'Create header line
strHeader = "Order Date" & " " & "Quantity" _
& " " & "ProductName"
strBody = strHeader & vbCrLf & vbCrLf
'Put orders data into body of email
Set rstOrders = CurrentDb.OpenRecordset(strQueryOrders)
'Debug.Print "Processing orders for " & strCompany
Do While Not rstOrders.EOF
dteOrder = Nz(rstOrders![OrderDate])
strItem = Nz(rstOrders![ProductName])
lngQuantity = Nz(rstOrders![Quantity])
strQuantity = FormatNo(lngQuantity)
'Create line of body text
strLine = Format(dteOrder, "mm/dd/yyyy") & " " _
& strQuantity & " " & strItem
'Debug.Print "Line text: " & strLine
strBody = strBody & strLine & vbCrLf
rstOrders.MoveNext
Loop
msg.body = strBody
msg.Display
End If
End If
ErrorHandlerExit:
Set appOutlook = Nothing
Exit Sub
ErrorHandler:
MsgBox "Error No: " & Err.Number _
& " in EmailPlainText procedure; " _
& "Description: " & Err.Description
Resume ErrorHandlerExit
End Sub
Public Sub EmailHTML(strSelectedCustomerID As String)
On Error GoTo ErrorHandler
Dim appOutlook As New Outlook.Application
Debug.Print "Selected Customer ID: " & strSelectedCustomerID
If strSelectedCustomerID = "ALL" Then
'Create emails for all customers
Set rstCustomers = CurrentDb.OpenRecordset("tblCustomers")
strQueryOrders = "qrySelectedOrders"
Do While Not rstCustomers.EOF
'Create filtered recordset of orders for this customer
strEMail = Nz(rstCustomers![Email])
strCompany = Nz(rstCustomers![CompanyName])
strSubject = "Orders for " & strCompany
strCustomerID = Nz(rstCustomers![CustomerID])
If strCustomerID <> "" Then
strSQL = "SELECT * FROM qryOrdersWithDetailsDateRange WHERE " _
& "[CustomerID] = " & Chr(39) & strCustomerID & Chr(39) & ";"
End If
Debug.Print "SQL for " & strQueryOrders & ": " & strSQL
lngCount = CreateAndTestQuery(strQueryOrders, strSQL)
Debug.Print "No. of items found: " & lngCount
If lngCount = 0 Then
GoTo NextCustomer
Else
'Create email for this customer
Set msg = appOutlook.CreateItem(olMailItem)
msg.To = strEMail
msg.Subject = strSubject
'Create starter HTML text for this customer
strHTMLBody = ""
strHeader = "<p> <font face='Arial', size=3>" _
& "Your orders are listed below: <br><br>" _
& "<table width='500' border='1'>" _
& " <tr>" _
& " <td width='50'height='26' nowrap valign='bottom'" _
& "align='left'><font face='Arial', " _
& "size=3><strong>Order Date</strong></font></td>" _
& " <td width='25' height='26'nowrap valign='bottom'" _
& "align='left'><font face='Arial', " _
& "size=3><strong>Quantity</strong></font>" _
& " <td width='200'height='26' nowrap valign='bottom'" _
& "align='left'><font face='Arial', " _
& "size=3><strong>Item</strong></font></td>" _
& " </tr>"
'Put orders data into body of email
Set rstOrders = CurrentDb.OpenRecordset(strQueryOrders)
Debug.Print "Processing orders for " & strCompany
Do While Not rstOrders.EOF
dteOrder = Nz(rstOrders![OrderDate])
strOrderDate = Format(dteOrder, "Short Date")
strItem = Nz(rstOrders![ProductName])
lngQuantity = Nz(rstOrders![Quantity])
'Create line of body text
strLine = "<font face='Arial', size=3" _
& " <tr>" _
& " <td width='5'valign='bottom' align='center'>" _
& strOrderDate & "</td>" _
& " <td width='25' valign='bottom' align='center'>" _
& CStr(lngQuantity) & "</td>" _
& " <td width='200'valign='bottom' align='left'>" _
& strItem & "</td>" _
& " </tr></font>"
Debug.Print "Line text: " & strLine
strHTMLBody = strHTMLBody & strLine
rstOrders.MoveNext
Loop
msg.HTMLBody = strHeader & strHTMLBody
msg.Display
End If
NextCustomer:
rstCustomers.MoveNext
Loop
Else
'Create email for selected customer
strSQL = "SELECT * FROM qryOrdersWithDetailsDateRange WHERE " _
& "[CustomerID] = " & Chr(39) & strSelectedCustomerID _
& Chr(39) & ";"
strQueryOrders = "qrySelectedOrders"
'Debug.Print "SQL for " & strQueryOrders & ": " & strSQL
lngCount = CreateAndTestQuery(strQueryOrders, strSQL)
'Debug.Print "No. of items found: " & lngCount
If lngCount = 0 Then
strPrompt = "No records found; canceling"
strTitle = "Canceling"
MsgBox strPrompt, vbOKOnly + vbCritical, strTitle
GoTo ErrorHandlerExit
Else
Set rstCustomer = CurrentDb.OpenRecordset(strQueryOrders)
strEMail = Nz(rstCustomer![Email])
strCompany = Nz(rstCustomer![CompanyName])
strSubject = "Orders for " & strCompany
'Create email for this customer
Set msg = appOutlook.CreateItem(olMailItem)
msg.To = strEMail
msg.Subject = strSubject
'Create starter HTML text for this customer
strHTMLBody = ""
strHeader = "<p> <font face='Arial', size=3>" _
& "Your orders are listed below: <br><br>" _
& "<table width='500' border='1'>" _
& " <tr>" _
& " <td width='50'height='26' nowrap valign='bottom'" _
& "align='left'><font face='Arial', " _
& "size=3><strong>Order Date</strong></font></td>" _
& " <td width='25' height='26'nowrap valign='bottom'" _
& "align='left'><font face='Arial', " _
& "size=3><strong>Quantity</strong></font>" _
& " <td width='200'height='26' nowrap valign='bottom'" _
& "align='left'><font face='Arial', " _
& "size=3><strong>Item</strong></font></td>" _
& " </tr>"
'Put orders data into body of email
Set rstOrders = CurrentDb.OpenRecordset(strQueryOrders)
Debug.Print "Processing orders for " & strCompany
Do While Not rstOrders.EOF
dteOrder = Nz(rstOrders![OrderDate])
strOrderDate = Format(dteOrder, "Short Date")
strItem = Nz(rstOrders![ProductName])
lngQuantity = Nz(rstOrders![Quantity])
'Create line of body text
strLine = "<font face='Arial', size=3" _
& " <tr>" _
& " <td width='5'valign='bottom' align='center'>" _
& strOrderDate & "</td>" _
& " <td width='25' valign='bottom' align='center'>" _
& CStr(lngQuantity) & "</td>" _
& " <td width='200'valign='bottom' align='left'>" _
& strItem & "</td>" _
& " </tr></font>"
Debug.Print "Line text: " & strLine
strHTMLBody = strHTMLBody & strLine
rstOrders.MoveNext
Loop
msg.HTMLBody = strHeader & strHTMLBody
msg.Display
End If
End If
ErrorHandlerExit:
Set appOutlook = Nothing
Exit Sub
ErrorHandler:
MsgBox "Error No: " & Err.Number _
& " in EmailHTML procedure; " _
& "Description: " & Err.Description
Resume ErrorHandlerExit
End Sub
A Note on Outlook HTML
The dialect of HTML used in creating an Outlook HTML message is rather peculiar. It seems to more or less correspond to HTML 3.2, circa 1993 (at least, an HTML manual for that version was helpful). One extra peculiarity is the font sizing – instead of using actual font sizes in points (10 pt, 12 pt, etc), Outlook HTML uses sizes 1, 2 and 3. When writing code to create an HTML email message, you may need to do a lot of trial and error tinkering to get the results you want.
The Customers and Orders Form
The main form in the sample database is frmCustomersAndOrders, a main form with a subform displaying orders for each customer. The form footer has an option group for selecting the email format with a button for generating a message listing all orders for the customer, and a button for previewing a report of all orders for the current customer:
Figure B. The Customers and Orders form, with controls for emailing an orders list or previewing a report.
The Email Orders button uses the same code as the button on the main menu, but just the portion that creates an email for a single customer.
The report for Alfreds Futterkiste is shown below:
Figure C. The Orders report for a single customer
References
The code in the sample database needs the following references (in addition to the default references):
Microsoft DAO 3.6 Object Library (if running a version of Access older than 2007)
Microsoft Outlook 14.0 Object Library
Microsoft Word 14.0 Object Library (for SortDeclarations procedure only)
Microsoft Forms 2.0 Object Library (for SortDeclarations procedure only)
If you import code or objects into a database of your own, you may need to set one or more of these references. The version number may differ, depending on your Office version; check the version you have. References are set in the References dialog, opened from the VBA window. For more information on working with references, see Access Archon #107, Working with References.
Supporting Files
The zip file containing this article, in Word 97-2003 format, plus the supporting file(s), may be downloaded from the Access Archon page of my Web site, as accarch240.zip, which is the last entry in the table of Access Archon columns for Access Watch.
Document Name | Document Type | Place in |
Emailing Orders to Customers.accdb | Access 2007-2010 database (can be used in higher versions) | Wherever you want |