Accessing Outlook

'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

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

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