Public Sub SendOutlookMessage( _
    strEmailAddress As String, _
    strEmailCCAddress As String, _
    strEmailBccAddress As String, _
    strSubject As String, _
    strMessage As String, _
    blnDisplayMessage As Boolean, _
    Optional strAttachmentFullPath As String)
    
'* Copy this code and paste it into a new Access
'* Module. Click Tools > References and make sure
'* that "Microsoft Office Outlook x.0 Object Library"
'* is checked.
'*
'* This subroutine sends an e-mail message through
'* MS Outlook. If the "blnDisplayMessage" parm is
'* set to "False", the message is placed in the
'* Outlook Outbox. "True" displays the message, and
'* user will have to click "Send" to send it.
'*
'* Ex.:
'*
'* SendOutlookMessage _
'*      "john@doe.com", _
'*      "ccJane@doe.com", _
'*      "bccSue@doe.com", _
'*      "Subject", _
'*      "Body of Message", _
'*      False, _
'*      "C:\My Documents\MyAttachmentFile.txt"
    
Dim objApp As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecipient As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim blnOutlookInitiallyOpen As Boolean
Dim strProcName As String

On Error Resume Next
strProcName = "SendOutlookMessage"

blnOutlookInitiallyOpen = True
Set objApp = GetObject(, "Outlook.Application")
If objApp Is Nothing Then
    Set objApp = CreateObject("Outlook.Application")
    '* Outlook wasn't open when this function started.
    blnOutlookInitiallyOpen = False
End If
If Err <> 0 Then Beep: _
    MsgBox "Error in " & strProcName & " (1): " _
        & Err.Number & " - " & Err.Description: _
    Err.Clear: _
    GoTo Exit_Section

'Create the message
Set objOutlookMsg = objApp.CreateItem(olMailItem)
If Err <> 0 Then Beep: _
    MsgBox "Error in " & strProcName & " (2): " _
        & Err.Number & " - " & Err.Description: _
    Err.Clear: _
    GoTo Exit_Section
    
With objOutlookMsg
    Set objOutlookRecipient = .Recipients.Add(strEmailAddress)
    objOutlookRecipient.Type = olTo
    If strEmailCCAddress = "" Then
    Else
        Set objOutlookRecipient = .Recipients.Add(strEmailCCAddress)
        objOutlookRecipient.Type = olCC
    End If
    If strEmailBccAddress = "" Then
    Else
        Set objOutlookRecipient = .Recipients.Add(strEmailBccAddress)
        objOutlookRecipient.Type = olBCC
    End If
    .subject = strSubject
    .Body = strMessage

    '* Add attachments
    If Not IsMissing(strAttachmentFullPath) Then
        If Trim(strAttachmentFullPath) = "" Then
        Else
            Set objOutlookAttach = .Attachments.Add(strAttachmentFullPath)
            If Err <> 0 Then Beep: _
                MsgBox "Error in " & strProcName & " (3): " _
                    & Err.Number & " - " & Err.Description: _
                Err.Clear: _
                GoTo Exit_Section
        End If
    End If

    If blnDisplayMessage Then
        .Display
    Else
        '* Send message by putting it in the Outbox
        .Send
    End If
End With
    
If Err <> 0 Then Beep: _
    MsgBox "Error in " & strProcName & " (99): " _
        & Err.Number & " - " & Err.Description: _
    Err.Clear: _
    GoTo Exit_Section
    
Exit_Section:
    On Error Resume Next
    If Not blnOutlookInitiallyOpen Then
       objApp.Quit
    End If
    Set objApp = Nothing
    Set objOutlookMsg = Nothing
    Set objOutlookAttach = Nothing
    Set objOutlookRecipient = Nothing
    On Error GoTo 0
End Sub