Option Explicit


Private Sub Send_As_Mail(strTo As String, _
                         strSubject As String, _
                         strMessage As String)

Dim olApp As Object
Dim olInsp As Object
Dim oItem As Object
Dim wdDoc As Object
Dim oRng As Object
Dim bStarted As Boolean

    On Error Resume Next
    'Get Outlook if it's running
    Set olApp = GetObject(, "Outlook.Application")
    'Outlook wasn't running, start it from code
    If olApp = "" Then
        Set olApp = CreateObject("Outlook.Application")
        bStarted = True
    End If
    If olApp = "" Then
        MsgBox "Outlook Not available."
        GoTo lbl_Exit
    End If
    'On Error GoTo Err_Handler:

    'Create a new mailitem
    Set oItem = olApp.CreateItem(0)

    With oItem
        .To = strTo
        .Subject = strSubject
        .BodyFormat = 2
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range(0, 0)
        oRng.Text = strMessage
        .Display
        '.Send        'restore after testing
    End With
    'If bStarted Then olApp.Quit 'restore after testing
lbl_Exit:
    Set oItem = Nothing
    Set olApp = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
    Exit Sub
err_Handler:
    Resume lbl_Exit
End Sub