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

Secrets and tips for the Windows 10 November 2019 update

A detailed and independent look at Windows 10, especially for Microsoft Office.

Fully up-to-date with coverage of the November 2019 major update of Windows 10.

This 1,000 pages, 40 chapter book shows you important features and details for Windows 10 users.

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.

Latest news & secrets of Microsoft Office

Microsoft Office experts give you tips and help for Word, Excel, PowerPoint and Outlook.

Give it a try. You can unsubscribe at any time.  Office Watch has been running for over 20 years, we've never, ever revealed or sold subscriber details.  Privacy policy

Invalid email address

Thanks for joining us! You'll get a welcome message in a few moments.