9/29/09

Outlook Send E-mail Without Security Warning

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:


Outlook E-mail Warning


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 OLE Automation.

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

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

  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

Requirements

  • Outlook 2003 (earlier versions of Outlook do not "trust" the VBA code inside the Outlook VBA Project)

Pros

  • Doesn't need any DLLs or external libraries

Cons

  • You need to add some code to the VBA project inside of Outlook

  • Outlook 'Macro Security' level must be set to LOW or MEDIUM

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=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.
'

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), "", 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 '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 (Ctrl+G shortcut):

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

Test E-mail Function

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=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 = "" & _
"" & _
"My HTML message text!" & _
"" & _
""
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
http://www.everythingaccess.com/tutorials.asp?ID=Outlook-Send-E-mail-Without-Security-Warning
 

1 comment:

Alex said...

Only one program relieved me in last problem with ms outlook. I accidentally caught sight it at one soft blog. The software made me happy and I'm sure that it would become the best resolution for any other outlook problem - how to read .ost.