Skip to main content

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.

Comments

Popular posts from this blog

SMTP servers of South Africa

SMTP Settings Below is a list of SMTP sites in South Africa, using this and the ISP Map you can try and find which one works best for you. Telkom smtp.saix.net (ADSL) smtp.telkomsa.co.za (56k dial up) smtp.telkomsa.net Internet Solutions smtp.isdsl.net (ADSL) smtp.dial-up.net (56k dial up on IS) smtp.layerone.net (3g backbone) Vodacom smtp.vodacom.co.za smtp.vodamail.co.za MTN smtp.mtn.co.za Cell C smtp.cellc.co.za (GPRS) mail.cmobile.co.za (also used by Virgin) ABSA mail.absa.co.za iBurst smtp.wbs.co.za smtp.iburst.co.za @lantic smtp.lantic.net (ADSL,Dialup, ISDN) Sentech smtp.sentech.co.za MWEB smtp.mweb.net (ADSL) - this is to be retired End June 2012, use below instead smtp.mweb.co.za (56k dial-up & ADSL & business) iAfrica smtp.uunet.co.za smtp.iafrica.com Neotel smtp.neotel.co.za Tiscali NOW MWeb smtp.tiscali.co.za Netactive NOW MWeb smtp.netactive.co.za Global smtp.global.co.za Hertzner Use y

Fixing winmail.dat problem - specifically in Quickbooks

For months we have had problems with attachments from Quickbooks. Having looked down many avenues I think we have found a fix or few: (See below for update) Here are a few websites that help out: Microsoft Outlook/Exchange MS-TNEF handling (aka "Winmail.dat", "Win.dat", or "Part 1.2" problem of unopenable email attachments) http://news.office-watch.com/t/n.aspx?a=716 KB958012 : When you use Outlook 2007 to send an e-mail message, the recipient of the message sees an attachment that is called Winmail.dat Essentially the summary is that there is a problem with Outlook trying to force Rich Text Format. so you need to turn that off. Mail users not receiving email in an Outlook derivative will have a problem. This format is called So: Go into Outlook On the "Tools" menu, click "Options", then click the "Mail Format" tab, and then the "Internet Format" button. Set "When sending Outlook Ri