none
send email from Access via Outlook (VBA)

    Question

  • Hi,

    I was wondering if I could get some help here. I have the following VBA codes (acquired from the Internet) that would enable user to use Access 2003 application to send emails out via Outlook 2003.

    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), "<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 '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
    
     
    
    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 = "<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

     

    The above codes written by Wayne does work on my machine running on XP Pro SP3 with Office 2003.

    Now, because I have already got the office 2010 on my new laptop, I copy and paste the code onto the Outlook 2010 and saved it. I re-use the Access database I created using Access 2003. I could open the database without any issue but when I ran the code in Access, I got an error message saying "Object does not support this method or property".

    I wonder if there is anything else I need to change so that the codes would work again on Office 2010.

     

    Thank you in advance

     

     

     

    Thursday, October 07, 2010 5:19 AM

Answers