Programmatically send email in Access using VBA and Outlook

When I first wrote my early Access system I used a function I setup in Outlook and then I called that. On upgrading I had a few problems with the older method then I found some help on the MSDN website here... and the related video.

The first thing to do before starting the code is go into access, access the VBA (press Ctl+G) then click on "Tools" The "References" and then make sure you scroll down to "Microsoft Outlook ..." the version there will be determined by what version you have installed. This the code that I ended up with after looking at the site above

Private olApp As Outlook.Application
Private olNameSpace As Outlook.NameSpace

' The basics of this from MSDN site
' http://msdn.microsoft.com/en-us/library/ee208547(v=office.12).aspx
Private Sub InitOutlook()
 ' Initialize a session in Outlook
  Set olApp = New Outlook.Application

  'Return a reference to the MAPI layer
  Set olNameSpace = olApp.GetNamespace("MAPI")

  'Let  user logon to Outlook with the Outlook Profile dialog box
  ' if not already logged in and then create a new session
  olNameSpace.Logon , , True, False
End Sub

Private Sub CleanUp()
  ' Clean up public object references.
  Set olNameSpace = Nothing
  Set olApp = Nothing
End Sub

'SendMAPIEmailto replace the older one
Public Function SendMAPIEmail(strTo As String, _
          strSubject As String, _
          strMessageBody As String, _
          Optional strAttachmentPaths As String, _
          Optional strCC As String, _
          Optional strBCC As String, _
          Optional strReplyTo As String, _
          Optional dtDTWhen As Date) As Boolean
        
  Dim mailItem As Outlook.mailItem
  Dim bSuccess As Boolean

  ' assume success but set error trap
  bSuccess = True

On Error GoTo Abort

  ' if calling in a loop perhaps remove then clean, at end of loop
  InitOutlook
  If Not olApp Is Nothing Then
   Set mailItem = olApp.CreateItem(olMailItem)

   mailItem.To = strTo
   mailItem.Subject = strSubject

   ' mailItem.Display
   mailItem.HTMLBody = strMessageBody
   '------------ add all the optional items
   ' attachments
   If Not IsMissing(strAttachmentPaths) Then
    If (strAttachmentPaths <> "") Then
     Dim myAttachements As Outlook.Attachments
     Set myAttachements = mailItem.Attachments
     ' may need a little more work here
     myAttachements.Add strAttachmentPaths
    End If
   End If
   ' CC string
   If Not IsMissing(strCC) Then
    If strCC <> "" Then
     mailItem.CC = strCC
    End If
   End If
   ' BCC string
   If Not IsMissing(strBCC) Then
    mailItem.BCC = strBCC
   End If
   ' ReplyTo string
   If Not IsMissing(strReplyTo) Then
    mailItem.ReplyRecipients.Add strReplyTo
   End If
   ' dtDTWhen string
   If Not IsMissing(dtDTWhen) Then
    mailItem.DeferredDeliveryTime = dtDTWhen
   End If
'   When debugging this is useful
'   mailItem.Display

   mailItem.Send

   GoTo EndSend
  End If

' if we get here then something wne wrong
Abort:
  bSuccess = False
' clean up and exit
EndSend:
  CleanUp
  SendMAPIEmail = bSuccess

End Function I prefer to use MAPI, since then I can see a log of what has been sent to whom. If you do that use SMTP, then you need to place the email results in a log of some sort.