Accessing Outlook

[koptastic69]

I have a piece of code that I'm running from Access that processes some email attachments.

I'm getting our old friend "A program is trying to access e-mail address information stored in Outlook"

Is there a way to disable this from within Access or is it an Outlook issue?

 

[CBrighton]

If you are able to add code to Outlook and (this is the important part) certify the code, then yes.

Use this function in an Access module to send emails:

'This is the procedure that calls the Outlook VBA function...
Public Function SendEmail(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
    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
 
    SendEmail = blnSuccessful
 
End Function

And put this function in the Outlook VBA:

Public Function FnSendMailSafe(strTo As String, _
                                strCC As String, _
                                strBCC As String, _
                                strSubject As String, _
                                strMessageBody As String, _
                                Optional strAttachments As String) As Boolean
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
    
    blnSuccessful = True
    
ExitRoutine:
    Set MAPISession = Nothing
    FnSendMailSafe = blnSuccessful
    
    Exit Function
    
ErrorHandler:
    Resume ExitRoutine
End Function

I personally use this code in macros using the RunCode option, for example:

SendEmail("CBrighton@email.com","Test Email","This is a test.","c:\test.txt")


In case you were planning on using this to send Access objects (reports, queries, etc) you should know that there's no way to override the overwrite dialig which OutputTo gives if the file already exists, so here's a simple module to replace OutputTo:

Public Function ExportEmailFile(strOutputFile As String, _
            strObjectName As String, _
            strOutputType As String)
    
    Dim strFileType As String
    
    If Len(Dir(strOutputFile)) Then
        Kill strOutputFile
    End If
    
    If strOutputType = "Report" Then
        DoCmd.OutputTo acOutputReport, strObjectName, acFormatRTF, strOutputFile, False
    ElseIf strOutputType = "Query" Then
        DoCmd.OutputTo acOutputQuery, strObjectName, acFormatXLS, strOutputFile, False
    End If
        
End Function

As you can see it's only setup for reports & queries and it assumes all reports will be .rtf and all queries .xls, but you can tweak it for other kinds of objects.

 

[koptastic69]

Thanks for the full and very detailed response. I'm not however wanting to send emails from within Access, merely to detach the attachments that are in the inbox. This warning message is fouling up an otherwise slick operation! Grrr.......

 

[CBrighton]

Ah, then ignore the code but note the general idea.

When you can create / find a function to allow you to do it you can put it in the Outlook VBA and self certify it. You can then call that Outlook function from Access to bypass the warning message as Outlook is running its own code.