Sample code for sending a formatted email in Microsoft Access

The main purpose of this sample code is to show how you can created a nicely formatted email with properly spaced emails.   This code shows you how to loop through a recordset of finished dispatches sending individual emails for each dispatch. 

You can also see examples of properly formatted date and times as well as right justified numbers and currency amounts.  Finally you can see an example of how to read and format detail line items, such as parts details, for each dispatch.  vbCrLf is used to start a new line.

However given the wide prevalence of email readers which can read and format HTML bodies using tables and HTML code is likely a better solution.

Set RS = MyDB.OpenRecordset("Email - Finished Dispatchs")
lngRSCount = RS.RecordCount
If lngRSCount = 0 Then
   MsgBox "No finished dispatch email messages to send.", vbInformation
Else
  RS.MoveLast
  lngRSCount = RS.RecordCount
  RS.MoveFirst
  Do Until RS.EOF
  lngCount = lngCount + 1
  lblStatus.Caption = "Writing Message " & CStr(lngCount) _
    & " of " & CStr(lngRSCount) & "..."
  Mail1.Subject = "Completed Dispatch " & CStr(RS!dID)

' Dispatch Info
  strBody = "Attn: " & RS!dvDivisionAccountingContact & _
    " at " & RS!dvDivisionName & " division" & vbCrLf & vbCrLf & _
    "Dispatch Order " & CStr(RS!dID) & " has been completed." & vbCrLf & vbCrLf & _
    "Invoice Division: " & RS!dvDivisionName & vbCrLf & _
    "Parts Division: " & RS!PartsDivisionName & vbCrLf & _
    "Employee: " & RS!EmployeeDispatched & vbCrLf & _
    "Finished: " & Format(RS!dDateTimeFinished, "ddd, mmm d yyyy hh:mm:ss") & _
    vbCrLf & vbCrLf

' Customer Info
  strBody = strBody & "Contact :" & RS!dContact & vbCrLf & _
    "Customer:" & vbCrLf & _
    RS!cName & vbCrLf & _
    RS!cAddress & vbCrLf & _
    RS!cCity & " " & RS!cProvince & " " & RS!cPostalCode & vbCrLf & _
    "Phone: " & RS!cPhoneNumber & " Fax:" & RS!cFaxNumber & vbCrLf
  If Not IsNull(RS!cNotes) Then _
    strBody = strBody & "Customer Notes:" & vbCrLf & RS!cNotes & vbCrLf
  strBody = strBody & vbCrLf

' Details of service
  strBody = strBody & "Details of Service: " & vbCrLf & _
  RS!dDetailsofService & vbCrLf & vbCrLf

' Parts Details
'   This routine loops through all the parts details which belong to this particular dispatch
  Set RSPartsQry = MyDB.QueryDefs("Email - Finished Dispatch Parts")
  RSPartsQry.Parameters("DispatchID") = RS!dID
  Set RSParts = RSPartsQry.OpenRecordset()
  lngRSPartsCount = RSParts.RecordCount
  If lngRSPartsCount = 0 Then
    strBody = strBody & "No parts on this dispatch" & vbCrLf & vbCrLf
  Else
    RSParts.MoveFirst

    Do Until RSParts.EOF
    Dim strPartsText As String, strPartsQty As String, strPartsPrice As String
    Dim strPartsLine As String, strPartsExtPrice As String
    strPartsText = RSParts!coComponent
    strPartsLine = strPartsText & String(42 - Len(strPartsText), " ")
    strPartsQty = Format(RSParts!dpQuantity, "General Number")
    strPartsLine = strPartsLine & String(5 - Len(strPartsQty), " ") & _
      strPartsQty
      strPartsPrice = Format(RSParts!dpPrice, "Currency")
      strPartsLine = strPartsLine & String(10 - Len(strPartsPrice), " ") & _
      strPartsPrice
    strPartsExtPrice = Format(RSParts!dpQuantity * RSParts!dpPrice, "Currency")
    strPartsLine = strPartsLine & String(12 - Len(strPartsExtPrice), " ") & _
      strPartsExtPrice
    strBody = strBody & strPartsLine & vbCrLf
    RSParts.MoveNext
  Loop

  RSParts.Close
  Set RSParts = Nothing
  strTemp = Format(RS!dPartsSubtotal, "Currency")
  strBody = strBody & String(41, " ") & "Parts subtotal: " & _
  String(12 - Len(strTemp), " ") & strTemp & "*" & vbCrLf & vbCrLf
End If

' Details of labour
If RS!dRegularHours <> 0 Then
  strTemp = Format(RS!dRegularHours, "General Number")
  strBody = strBody & "Regular Hours: " & _
    String(12 - Len(strTemp), " ") & strTemp & " @ "
  strTemp = Format(RS!dRegularRate, "Currency")
  strBody = strBody & _
    String(12 - Len(strTemp), " ") & strTemp & " = "
  strTemp = Format(RS!dRegularHours * RS!dRegularRate, "Currency")
  strBody = strBody & _
    String(12 - Len(strTemp), " ") & strTemp & vbCrLf
End If

strTemp = Format(RS!dLabourSubtotal, "Currency")
strBody = strBody & String(29, " ") & _
  "Labour subtotal:" & String(12 - Len(strTemp), " ") & _
  strTemp & "*" & vbCrLf & vbCrLf

strTemp = Format(RS!dGSTAmount, "Currency")
strBody = strBody & "GST : " & _
  String(12 - Len(strTemp), " ") & strTemp & vbCrLf

strBody = strBody & vbCrLf & "*** end of Dispatch " _
  & CStr(RS!dID) & " ***" & vbCrLf & vbCrLf

'  Insert code to email the body and subject of the email as well as To address

  If TestOrLive = True Then
    RS.Edit
    RS("dDateTimeInvoiceEmailed") = Now()
    RS.Update
  End If
  RS.MoveNext
  Loop

End If
RS.Close
MyDB.Close
Set RS = Nothing
Set MyDB = Nothing
Close