Access VBA code to open outlook

It would be more efficient to handle this case more "internally".
Access can easily send email with the use of CDO or vbSend..this means no need for opening a rather hefty program like Outlook which in some cases would probably hang without room for handling it's error.

I agree, it is usually much better (and easier) to directly send emails using SMTP instead of Outlook. Unless you need to use a special feature, like the address book, or have authentication required without wanting to keep credentials in Access.

Have you tried SendObject?  Otherwise, you need to get into Outlook automation and custom functions like http://www.devhut.net/2010/09/03/vba-send-html-emails-using-outlook-automation/

To work with Outlook and avoid security prompts, you'll need either vbMAPI:

https://www.everythingaccess.com/vbmapi.asp

 or Outlook Redemption:

http://www.dimastr.com/redemption/home.htm

Jim.

Note too that CDO is deprecated and is no longer included by default with new Exchange installs. I believe you can still install it, and many Exchange admins will install it, but you could run into troubles with it.

I use vbMAPI, as Jim D suggests, and it works very well, and is very easy to deploy - in fact, it's deployed entirely within your Access database, so requires no additional deployment.

Seems like everyone is intent on persuading you not to do what you wanted. But perhaps you have a good reason to want to use Outlook. Like not having to worry about getting credentials, and server names etc. in order to send email via SMTP. Or maybe you don't want to spend any more money on vbMAPI and other solutions. Or maybe...

Well anyhow. Here's the bare bones of how you can do what you wanted.

The function SendEmail does the necessary, and the rest of the code supports it. The parameters for SendEmail are

• sEmailAddress - a semicolon delimited list of email addresses
• sMessageHdr - the subject line
• sMessage - the body of the message
• bSilent - defaults to true, which means just send the message. If set to false then the message will be displayed on screen and the user must manually send it.
• strAttachmentPath - optional full path to a file to be attached to the email
• dReminderTime - optional time to remind the recipient about the email
• bDeleteAfterSending - optinally remove the sent message after it has gone out

Note, running this code with Access 2007 or 2010 when Outlook is not already running generates an error 287 when the email address is resolved in the function bVerifyEmailAddress.

This error is handled by searching for Outlook.exe and running it.

In  versions of Access  before 2007, and in versions 2016 and 2019, if Outlook is not running it is automatically started up and then closed down  after the email is sent. i.e. the error 287 does not happen.

So here is a whole module that will do the job...


'----Code Starts-------------------

Option Compare Database
Option Explicit

Private Declare Sub sapiSleep Lib "kernel32" _
                              Alias "Sleep" _
                              (ByVal dwMilliseconds As Long)
                              
Sub sSleep(lngMilliSec As Long)
    If lngMilliSec > 0 Then
        Call sapiSleep(lngMilliSec)
    End If
End Sub

Function SendEmail(sEmailAddress As String, sMessageHdr As String, sMessage As String _
    , Optional bSilent As Boolean = True, Optional strAttachmentPath As String = "" _
    , Optional dReminderTime As Date = #1/1/1800#, Optional bDeleteAfterSending = True) As Boolean
    Dim objOutlook As Outlook.Application
    Dim objOutlookMsg As Outlook.MailItem
    Dim objOutlookRecip As Outlook.Recipient
    Dim bResult As Boolean
    On Error GoTo SendEmail_err
    If sEmailAddress & "" > "" Then
        ' Create the Outlook session.
        Set objOutlook = CreateObject("Outlook.Application")

        ' Create the message.

        Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
        '''''''''''Set objOutlookRecip = objOutlookMsg.Recipients(0)

        With objOutlookMsg
            ' Set the Subject, Body
            .Subject = sMessageHdr
            .Body = sMessage
            AddToRecipients sEmailAddress, objOutlookMsg, objOutlookRecip
            .DeleteAfterSubmit = bDeleteAfterSending    ' don't clutter user's Sent Items folder
            If strAttachmentPath & "" > "" Then .Attachments.Add strAttachmentPath
            If dReminderTime <> #1/1/1800# Then .ReminderTime = dReminderTime
            bResult = SendEmailMessage(objOutlookMsg, Not bSilent)
        End With
        Set objOutlookRecip = Nothing
        Set objOutlookMsg = Nothing
        Set objOutlook = Nothing
        SendEmail = bResult
    End If
    Exit Function
SendEmail_err:
    SendEmail = False
End Function




Private Function SendEmailMessage(objOutlookMsg As Outlook.MailItem, Optional bEdit As Boolean = False) As Boolean
'============================================================
'     Purpose: Send a fully prepared email message
'  Parameters: objOutlookMsg the MailItem to be sent
'              bEdit - if true then display the message window to allow editing
'                      else send the message without user interaction
'============================================================

    Dim objOutlookRecip As Outlook.Recipient
    On Error GoTo SendEmailMessage_err
    For Each objOutlookRecip In objOutlookMsg.Recipients
        If Not objOutlookRecip.Resolve = True Then
            objOutlookRecip.Delete
        End If
    Next
    Set objOutlookRecip = Nothing
    If objOutlookMsg.Recipients.count > 0 Then
        objOutlookMsg.ReadReceiptRequested = False
        If bEdit = True Then
            objOutlookMsg.Display
        Else
            objOutlookMsg.Send
        End If
        SendEmailMessage = True
    Else
        SendEmailMessage = False
    End If
    Exit Function
SendEmailMessage_err:
    MsgBox "Error " & Err.Number & " " & Err.Description
    SendEmailMessage = False
End Function



Private Function bVerifyEmailAddress(CM_Email As String) As Boolean
' Verify if email address is valid
    Const VERIFY_TRIES As Long = 5
    Dim objOutlook As Outlook.Application
    Dim objOutlookMsg As Outlook.MailItem
    Dim objOutlookRecip As Outlook.Recipient
    Dim n As Long

On Error GoTo bVerifyEmailAddress_Error
If Not CM_Email & "" = "" Then
  ' Create the Outlook session.
  Set objOutlook = CreateObject("Outlook.Application")

  ' Create the message.

  Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

  With objOutlookMsg
      ' Add the To recipient(s) to the message.
      Set objOutlookRecip = .Recipients.Add(CM_Email)
      ' Resolve each Recipient's name.
      For Each objOutlookRecip In .Recipients
          n = 0
          Do While n < VERIFY_TRIES And Not objOutlookRecip.Resolve = True
              sSleep 500    ' wait half a second and try again
              DoEvents
              n = n + 1
          Loop
          If n = VERIFY_TRIES Then    ' failed to resolve the address
              'sBadEmails = sBadEmails
              objOutlookRecip.Delete
              bVerifyEmailAddress = False
          Else
              bVerifyEmailAddress = True
          End If
      Next
  End With
  Set objOutlookRecip = Nothing
  Set objOutlookMsg = Nothing
  Set objOutlook = Nothing
Else
  bVerifyEmailAddress = False
End If
bVerifyEmailAddress_Exit:
On Error GoTo 0
Exit Function

bVerifyEmailAddress_Error:
    Dim strOlPath As String
Select Case Err.Number
    Case 0    ' No Error
  DoEvents
Case 287    ' Application-defined or object-defined error
  ' In Access 2007/2010 the call to .Recipients.Add generates this error if Outlook is not already running
  ' So here we will locate Outlook and then run it
  strOlPath = FindOutlook()
  If strOlPath > "" Then
      Shell strOlPath, vbMinimizedNoFocus
      Resume
  Else
      MsgBox "Error sending Email message. Please start Outlook then click the 'OK' button and we will try again.", vbOKOnly Or vbExclamation
      Resume
  End If
Case Else
  MsgBox "Error " & Err.Number & " : " & Err.Description & " at line " & Erl, vbOKOnly, "bVerifyEmailAddress"
  Resume bVerifyEmailAddress_Exit
End Select
End Function

Private Function FindOutlook() As String
    Dim strOlPath As String
    Dim strFile As String
    Dim strTemp As String
    Dim n As Long
    ' try the folder that Access is installed in first
    FindOutlook = ""    ' default
    strOlPath = SysCmd(acSysCmdAccessDir)
    strFile = Dir(strOlPath & "Outlook.exe")
    If strFile & "" > "" Then
        FindOutlook = strOlPath & strFile
    Else
        ' not found. Search the Program FIles folder
        strTemp = Split(strOlPath, "\")(0) & "\" & Split(strOlPath, "\")(1)
        With Application.FileSearch
            .LookIn = strTemp
            .SearchSubFolders = True
            .fileName = "Outlook.exe"
            .Execute
            If .FoundFiles.count > 0 Then
                For n = 1 To .FoundFiles.count
                    If InStr(.FoundFiles(n), "Outlook.Exe") > 0 Then
                        FindOutlook = .FoundFiles(n)
                        Exit For
                    End If
                Next n
            End If
        End With
    End If
End Function

Private Sub AddToRecipients(sToEmail As String, objMailMessage As Outlook.MailItem, objOutlookRecip As Outlook.Recipient)
'============================================================
'     Purpose: Add a semi-colon delimited list of email address to the To: header
'  Parameters: sToEmail - the delimited list
'              objMailMessage - an initialise MailItem object
'              objOutlookRecip - the recipient object that recieves the emails addresses
'============================================================
    Dim vTemp As Variant
    Dim n As Integer
    Dim Addresses As Variant
    Addresses = Split(sToEmail, ";")
    n = 0
    For n = LBound(Addresses) To UBound(Addresses)
        vTemp = Addresses(n)    ' get the n'th email address from our list
        With objMailMessage
            If bVerifyEmailAddress(CStr(vTemp)) Then
                Set objOutlookRecip = .Recipients.Add(CStr(vTemp))
                objOutlookRecip.Type = olTo
            Else
                MsgBox "The email address " & vTemp & vbCrLf & vbCrLf & "appears to be invalid." & vbCrLf & vbCrLf & "Please check it and add it manually to the message.", vbInformation, "Email Address Error"
            End If
        End With
    Next n
End Sub

Select allOpen in new window

'----Code Ends---------------------

<<Seems like everyone is intent on persuading you not to do what you wanted.>>

  Yes and no.   He mentioned Outlook, but there are other ways to send mail if that's all you want to do.

  if you do use Outlook, then you need some type of 3rd  party utility to get around the security dialog's.  Sending mail directly to an SMTP server avoids having to buy anything (it does have other issues though, like having to know the server details and being able to reach the server).  

  If he does stick with Outlook, then buying a 3rd party utility will change the code he needs as you would work through the lib rather than directly with the Outlook object model.

  I will give you that he didn't mention if he wanted a totally automated solution, but virtually everyone that uses code like you posted, the very next question is "How can I get rid of the security dialogs?"

 We all were just trying to avoid that up-front.  Certainly the code you posted will work, but he's going to be stuck with the dialogs.

Jim.

Hi Jim.

Well I really cannot say that I know why - what changes MS may have made as I never saw any announcements back in the day - but in my experience,  since version 2010 (and possibly 2007, I don't quite remember that far back) those security dialogs just do not show up anymore. I used to use a third party tools called 'ClickYes' but I no longer need to.

The only changes I have made to the default setup for Access is in the Trust Center where I have set the option to enable all macros.

Anyone want to try my code to see if they get the dreaded Outlook security prompts? I'm curious to know.

???

Lambert :-)