Outlook Send E-mail Without Security Warning

If you've ever tried to send an e-mail programmatically from Access when using Outlook 2000 SP-2 or above, no doubt you will have seen this message:

This is part of the Outlook Security Model and cannot be disabled.  This security 'feature' affects all Simple MAPI operations including the DoCmd.SendObject method in Microsoft Access and all Outlook Automation.

Having this message pop up in an automated application is simply unacceptable for developers.  Fortunately there are a few workarounds.

1. The newest and by far the easiest solution is to use our vbMAPI Outlook Security Evader product.  This product provides a set of VB class modules that replicate the functionality of the Outlook Object Model, but without the security prompts.  This product is just a set of VB class modules that you import into your application and as such does not require any third party DLLs to be distributed with your application.  It really couldn't be simpler - if you are developing in VBA, VB6 or VB.NET I strongly advise you to check it out first.
2. Create or buy an application that simply presses the 'Yes' button after the elapsed 5 second delay. In my opinion this is a bad idea - but if you want to follow this route, have a search around the net.
3. This article solution: If using Outlook 2003, the VBA code stored inside of the VBA Project of Outlook is assumed to be "Trusted" - this then bypasses the warning messages - then you can call this VBA code using automation of Outlook.

Using the trusted state of Outlook 2003 VBA code to avoid the warning messages

In Outlook 2003, if a MAPI MailItem object is created from within the VBA project (specifically the 'ThisOutlookSession' module), it is assumed to be "Trusted" and will not prompt the usual security messages when attempting to call the .Send method or when making use of the Outlook address book. We will be using this "Trusted" method to create an exposed Outlook VBA function that creates and sends the MailItem and then call this using Automation from our application. In our example, we will be calling the exposed Outlook VBA function from within Access. The exposed function will be called FnSendMailSafe.

Before starting, the Outlook Macro Security level must be set to LOW or MEDIUM otherwise the custom VBA function will not be exposed through automation. Furthermore, if Outlook is closed when you try to send e-mails, you will either need to set the Outlook 'Macro Security' level to LOW rather than MEDIUM, OR you can sign the VBA code with a digital certificate, otherwise you will receive a warning about unsafe macros.

Note: If you have changed the Macro Security level you must now restart Outlook.

One problem that I ran into was that when Outlook is first opened, the VBA project doesn't expose any custom VBA functions unless either a VBA event has fired, or the user has manually opened the VBA IDE. The trick I've used below is to create a blank event called Application_Startup() in the ThisOutlookSession module - this event will fire as soon as Outlook opens and so the VBA project will load properly and our function will be exposed.

Setting up the Outlook VBA code

1. Open Outlook
2. Go to the menu item Tools / Macro / Visual Basic Editor
3. In the VB environment expand the project node (usually called 'Project1')
4. Find and open the module 'ThisOutlookSession' (double click to open)
5. Copy and paste the code from below

Option Explicit

' Code: Send E-mail without Security Warnings
' OUTLOOK 2003 VBA CODE FOR 'ThisOutlookSession' MODULE
' (c) 2005 Wayne Phillips (http://www.everythingaccess.com)
' Written 07/05/2005
' Last updated v1.4 - 26/03/2008
'
' Please read the full tutorial here:
' http://www.everythingaccess.com/tutorials.asp?ID=112
'
' Please leave the copyright notices in place - Thank you.

Private Sub Application_Startup()

    'IGNORE - This forces the VBA project to open and be accessible 
    '         using automation at any point after startup

End Sub

' FnSendMailSafe
' --------------
' Simply sends an e-mail using Outlook/Simple MAPI.
' Calling this function by Automation will prevent the warnings
' 'A program is trying to send a mesage on your behalf...'
' Also features optional HTML message body and attachments by file path. 
'
' The To/CC/BCC/Attachments function parameters can contain multiple items 
' by seperating them with a semicolon. (e.g. for the strTo parameter, 
' 'test@test.com; test2@test.com' would be acceptable for sending to 
' multiple recipients. 
'                   
Public Function FnSendMailSafe(strTo As String, _
                                strCC As String, _
                                strBCC As String, _
                                strSubject As String, _
                                strMessageBody As String, _
                                Optional strAttachments As String) As Boolean

' (c) 2005 Wayne Phillips - Written 07/05/2005
' Last updated 26/03/2008 - Bugfix for empty recipient strings
' http://www.everythingaccess.com
'
' You are free to use this code within your application(s)
' as long as the copyright notice and this message remains intact.

On Error GoTo ErrorHandler:

    Dim MAPISession As Outlook.NameSpace
    Dim MAPIFolder As Outlook.MAPIFolder
    Dim MAPIMailItem As Outlook.MailItem
    Dim oRecipient As Outlook.Recipient
    
    Dim TempArray() As String
    Dim varArrayItem As Variant
    Dim strEmailAddress As String
    Dim strAttachmentPath As String
    
    Dim blnSuccessful As Boolean

    'Get the MAPI NameSpace object
    Set MAPISession = Application.Session
    
    If Not MAPISession Is Nothing Then

      'Logon to the MAPI session
      MAPISession.Logon , , True, False

      'Create a pointer to the Outbox folder
      Set MAPIFolder = MAPISession.GetDefaultFolder(olFolderOutbox)
      If Not MAPIFolder Is Nothing Then

        'Create a new mail item in the "Outbox" folder
        Set MAPIMailItem = MAPIFolder.Items.Add(olMailItem)
        If Not MAPIMailItem Is Nothing Then
          
          With MAPIMailItem

            'Create the recipients TO
                TempArray = Split(strTo, ";")
                For Each varArrayItem In TempArray
                
                    strEmailAddress = Trim(varArrayItem)
                    If Len(strEmailAddress) > 0 Then
                        Set oRecipient = .Recipients.Add(strEmailAddress)
                        oRecipient.Type = olTo
                        Set oRecipient = Nothing
                    End If
                
                Next varArrayItem
            
            'Create the recipients CC
                TempArray = Split(strCC, ";")
                For Each varArrayItem In TempArray
                
                    strEmailAddress = Trim(varArrayItem)
                    If Len(strEmailAddress) > 0 Then
                        Set oRecipient = .Recipients.Add(strEmailAddress)
                        oRecipient.Type = olCC
                        Set oRecipient = Nothing
                    End If
                
                Next varArrayItem
            
            'Create the recipients BCC
                TempArray = Split(strBCC, ";")
                For Each varArrayItem In TempArray
                
                    strEmailAddress = Trim(varArrayItem)
                    If Len(strEmailAddress) > 0 Then
                        Set oRecipient = .Recipients.Add(strEmailAddress)
                        oRecipient.Type = olBCC
                        Set oRecipient = Nothing
                    End If
                
                Next varArrayItem
            
            'Set the message SUBJECT
                .Subject = strSubject
            
            'Set the message BODY (HTML or plain text)
                If StrComp(Left(strMessageBody, 6), "<HTML>", _
                            vbTextCompare) = 0 Then
                    .HTMLBody = strMessageBody
                Else
                    .Body = strMessageBody
                End If

            'Add any specified attachments
                TempArray = Split(strAttachments, ";")
                For Each varArrayItem In TempArray
                
                    strAttachmentPath = Trim(varArrayItem)
                    If Len(strAttachmentPath) > 0 Then
                        .Attachments.Add strAttachmentPath
                    End If
                
                Next varArrayItem

            .Send 'The message will remain in the outbox if this fails

            Set MAPIMailItem = Nothing
            
          End With

        End If

        Set MAPIFolder = Nothing
      
      End If

      MAPISession.Logoff
      
    End If
    
    'If we got to here, then we shall assume everything went ok.
    blnSuccessful = True
    
ExitRoutine:
    Set MAPISession = Nothing
    FnSendMailSafe = blnSuccessful
    
    Exit Function
    
ErrorHandler:
    MsgBox "An error has occured in the user defined Outlook VBA function " & _
            "FnSendMailSafe()" & vbCrLf & vbCrLf & _
            "Error Number: " & CStr(Err.Number) & vbCrLf & _
            "Error Description: " & Err.Description, _
                vbApplicationModal + vbCritical
    Resume ExitRoutine

End Function

Test the Outlook code

At this point, I would recommend testing the code by sending a test e-mail from the Outlook Immediate window (Ctrl+G shortcut):

?ThisOutlookSession.FnSendMailSafe("youremailaddress@here.com","","","Test","Test")

Once you've confirmed that you have installed the VBA code correctly, it's time for the Access OLE automation...

Calling our Outlook VBA function from within Access VBA code

1. Open your Access database
2. Create a new VBA module for testing purposes
3. Copy and paste the code from below

Option Explicit

' ACCESS VBA MODULE: Send E-mail without Security Warning
' (c) 2005 Wayne Phillips (http://www.everythingaccess.com)
' Written 07/05/2005
' Last updated v1.3 - 11/11/2005
'
' Please read the full tutorial & code here:
' http://www.everythingaccess.com/tutorials.asp?ID=112
'
' Please leave the copyright notices in place - Thank you.

' This is a test function! - replace the e-mail addresses 
' with your own before executing!!
' (CC/BCC can be blank strings, attachments string is optional)

Sub FnTestSafeSendEmail()
    Dim blnSuccessful As Boolean
    Dim strHTML As String
        
    strHTML = "<html>" & _
               "<body>" & _
               "My <b><i>HTML</i></b> message text!" & _
               "</body>" & _
               "</html>" 
    blnSuccessful = FnSafeSendEmail("myemailaddress@domain.com", _
                                    "My Message Subject", _
                                    strHTML)
    
    'A more complex example...    
    'blnSuccessful = FnSafeSendEmail( _
                        "myemailaddress@domain.com; recipient2@domain.com", _
                        "My Message Subject", _     
                        strHTML, _    
                        "C:\MyAttachFile1.txt; C:\MyAttachFile2.txt", _ 
                        "cc_recipient@domain.com", _  
                        "bcc_recipient@domain.com")

    If blnSuccessful Then
    
        MsgBox "E-mail message sent successfully!"
        
    Else
    
        MsgBox "Failed to send e-mail!"
    
    End If

End Sub


'This is the procedure that calls the exposed Outlook VBA function...
Public Function FnSafeSendEmail(strTo As String, _
                    strSubject As String, _
                    strMessageBody As String, _
                    Optional strAttachmentPaths As String, _
                    Optional strCC As String, _
                    Optional strBCC As String) As Boolean

    Dim objOutlook As Object ' Note: Must be late-binding.
    Dim objNameSpace As Object
    Dim objExplorer As Object
    Dim blnSuccessful As Boolean
    Dim blnNewInstance As Boolean
    
    'Is an instance of Outlook already open that we can bind to?
    On Error Resume Next
    Set objOutlook = GetObject(, "Outlook.Application")
    On Error GoTo 0
    
    If objOutlook Is Nothing Then
    
        'Outlook isn't already running - create a new instance...
        Set objOutlook = CreateObject("Outlook.Application")
        blnNewInstance = True    
        'We need to instantiate the Visual Basic environment... (messy)
        Set objNameSpace = objOutlook.GetNamespace("MAPI")
        Set objExplorer = objOutlook.Explorers.Add(objNameSpace.Folders(1), 0)
        objExplorer.CommandBars.FindControl(, 1695).Execute
                
        objExplorer.Close
                
        Set objNameSpace = Nothing
        Set objExplorer = Nothing
        
    End If

    blnSuccessful = objOutlook.FnSendMailSafe(strTo, strCC, strBCC, _
                                                strSubject, strMessageBody, _
                                                strAttachmentPaths)
                                
    If blnNewInstance = True Then objOutlook.Quit
    Set objOutlook = Nothing
    
    FnSafeSendEmail = blnSuccessful
    
End Function