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 OLE Automation.
Having this message pop up in an automated application is simply unacceptable for developers. Fortunately 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 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.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.
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
Open Outlook
Go to the menu item Tools / Macro / Visual Basic Editor
In the VB environment expand the project node (usually called 'Project1')
Find and open the module 'ThisOutlookSession' (double click to open)
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")
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
Open your Access database
Create a new VBA module for testing purposes
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:
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.
Post a Comment