Outlook Send E-mail Without Security Warning_outlook security send-CSDN博客

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 the DoCmd.SendObject functions, 'Simple MAPI' functions and Outlook Automation.

This poses a problem for many developers as having this message pop-up in an automated application is simply not acceptable. There are a few workarounds;

Create (or buy an ActiveX/DLL) that uses Extended MAPI to manage the creation of e-mails. The Outlook Security Model does not affect 'Extended MAPI', only 'Simple MAPI' - unfortunately you can't directly interface with Extended MAPI functions from VB/VBA, hence the need for an ActiveX control or DLL that would be written in a lower level language. Outlook Redemption is a popular DLL solution that uses Extended MAPI.

Create or buy an application that simply presses the 'Yes' button after the elapsed 5 second delay. This is a bad idea in my opinion - but have a search around the net if you want to follow this route.

If using Outlook 2003, make use of the fact that VBA code stored in the VBA Project inside Outlook is automatically "Trusted" - this bypasses the warning messages - then call this VBA code using automation of Outlook.

The remainder of this article is based on option #3 from above.

Important: This only works in Outlook 2003 - earlier versions of Outlook do not automatically put Outlook VBA code in a "Trusted" mode, therefore the warnings will still appear.

Please Note: This method isn't perfect since you are required to add some code to the Outlook VBA project, however it might be an option for you if your company does not allow the use of custom DLLs etc.

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 can use this "Trusted" method to create an exposed Outlook VBA function that creates and sends the MailItem and then call this using Automation. In our case, we will be calling the exposed Outlook VBA function from within Access.

For this example, I've created a function called FnSendMailSafe within the ThisOutlookSession module of Outlook VBA project. This function creates the mail object, sets the parameters and then sends it.

One problem is that when Outlook is first opened, the VBA project doesn't expose the custom VBA function unless either a VBA event has fired, or the user has manually opened the VBA IDE. The trick I've used is to also 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.

Finally, the Outlook Macro Security level must be set to LOW or MEDIUM otherwise the custom VBA function will not be exposed through automation.
(Note: If you have changed the Macro Security level you must restart Outlook).

Furthermore, if Outlook is closed when you try to send e-mails, you will probably need to set the macro security level to LOW rather than MEDIUM, otherwise you may receive a warning about unsafe macros.

Here's the Outlook 2003 VBA code: (copy and paste into the ThisOutlookSession VBA module)


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
' Updated v1.3 - 11/11/2005
'
' Please read the full tutorial here:
' http://www.everythingaccess.com/tutorials.asp?ID=Outlook-Send-E-mail-without-Security-Warning
'
' 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 by a semicolon. (e.g. for the strTo parameter, 'test@test.com; test2@test.com' is
' acceptable for sending to multiple recipients. 
'
' Read more here:
' http://www.everythingaccess.com/tutorials.asp?ID=Outlook-Send-E-mail-without-Security-Warning
'                 
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
' 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 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
                
                    Set oRecipient = .Recipients.Add(CStr(Trim(varArrayItem)))
                    oRecipient.Type = olTo
                    Set oRecipient = Nothing
                
                Next varArrayItem
            
            'Create the recipients CC 
                TempArray = Split(strCC, ";")
                For Each varArrayItem In TempArray
                
                    Set oRecipient = .Recipients.Add(CStr(Trim(varArrayItem)))
                    oRecipient.Type = olCC
                    Set oRecipient = Nothing
                
                Next varArrayItem
            
            'Create the recipients BCC 
                TempArray = Split(strBCC, ";")
                For Each varArrayItem In TempArray
                
                    Set oRecipient = .Recipients.Add(CStr(Trim(varArrayItem)))
                    oRecipient.Type = olBCC
                    Set oRecipient = Nothing
                
                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
                
                    .Attachments.Add CStr(Trim(varArrayItem))
                    
                Next varArrayItem

            .Send 'No return value since the message will remain in the outbox if it fails to send 

            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:

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

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

And here's the Access VBA code used to call the function via Automation (example uses late-binding object):


Option Explicit

' ACCESS VBA MODULE: Send E-mail without Security Warning
' (c) 2005 Wayne Phillips (http://www.everythingaccess.com)
' Written 07/05/2005
' Updated v1.3 - 11/11/2005
'
' Please read the full tutorial & code here:
' http://www.everythingaccess.com/tutorials.asp?ID=Outlook-Send-E-mail-without-Security-Warning
'
' 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; secondrecipient@domain.com", _
                                     "My Message Subject", _
                                     strHTML, _
                                     "C:/MyAttachmentFile1.txt; C:/MyAttachmentFile2.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