Option Explicit 
 
Private Type MAPIMessage 'Mail
    Reserved       As Long 
    Subject        As String 
    NoteText       As String 
    MessageType    As String 
    DateReceived   As String 
    ConversationID As String 
    Flags          As Long 
    RecipCount     As Long 
    FileCount      As Long 
End Type 
 
Private Type MapiRecip 'Recipient
    Reserved   As Long 
    RecipClass As Long 
    Name       As String 
    Address    As String 
    EIDSize    As Long 
    EntryID    As String 
End Type 
 
Private Type MapiFile 'File
    Reserved As Long 
    Flags    As Long 
    Position As Long 
    PathName As String 
    FileName As String 
    FileType As String 
End Type 
 
 ' MAPI Return Codes
Private Const SUCCESS_SUCCESS = 0 
Private Const MAPI_USER_ABORT = 1 
Private Const MAPI_E_USER_ABORT = MAPI_USER_ABORT 
Private Const MAPI_E_FAILURE = 2 
Private Const MAPI_E_LOGIN_FAILURE = 3 
Private Const MAPI_E_LOGON_FAILURE = MAPI_E_LOGIN_FAILURE 
Private Const MAPI_E_DISK_FULL = 4 
Private Const MAPI_E_INSUFFICIENT_MEMORY = 5 
Private Const MAPI_E_BLK_TOO_SMALL = 6 
Private Const MAPI_E_TOO_MANY_SESSIONS = 8 
Private Const MAPI_E_TOO_MANY_FILES = 9 
Private Const MAPI_E_TOO_MANY_RECIPIENTS = 10 
Private Const MAPI_E_ATTACHMENT_NOT_FOUND = 11 
Private Const MAPI_E_ATTACHMENT_OPEN_FAILURE = 12 
Private Const MAPI_E_ATTACHMENT_WRITE_FAILURE = 13 
Private Const MAPI_E_UNKNOWN_RECIPIENT = 14 
Private Const MAPI_E_BAD_RECIPTYPE = 15 
Private Const MAPI_E_NO_MESSAGES = 16 
Private Const MAPI_E_INVALID_MESSAGE = 17 
Private Const MAPI_E_TEXT_TOO_LARGE = 18 
Private Const MAPI_E_INVALID_SESSION = 19 
Private Const MAPI_E_TYPE_NOT_SUPPORTED = 20 
Private Const MAPI_E_AMBIGUOUS_RECIPIENT = 21 
Private Const MAPI_E_AMBIG_RECIP = MAPI_E_AMBIGUOUS_RECIPIENT 
Private Const MAPI_E_MESSAGE_IN_USE = 22 
Private Const MAPI_E_NETWORK_FAILURE = 23 
Private Const MAPI_E_INVALID_EDITFIELDS = 24 
Private Const MAPI_E_INVALID_RECIPS = 25 
Private Const MAPI_E_NOT_SUPPORTED = 26 
 
Private Const MAPI_ORIG = 0 'Recipient-Flags
Private Const MAPI_TO = 1 
Private Const MAPI_CC = 2 
Private Const MAPI_BCC = 3 
 
Private Const MAPI_LOGON_UI = &H1 'Logon Flags
Private Const MAPI_NEW_SESSION = &H2 
Private Const MAPI_FORCE_DOWNLOAD = &H1000 
 
Private Const MAPI_LOGOFF_SHARED = &H1 'Logoff Flags
Private Const MAPI_LOGOFF_UI = &H2 
 
Private Const MAPI_DIALOG = &H8 'Send-Mail-Flags
Private Const MAPI_NODIALOG = 0 
 
Private Const MAPI_OLE = &H1 
Private Const MAPI_OLE_STATIC = &H2 
 
Private Const MAPI_UNREAD = &H1 'Mail-Flags
Private Const MAPI_RECEIPT_REQUESTED = &H2 
Private Const MAPI_SENT = &H4 
 
Private Declare Function MAPILogon Lib "MAPI32.DLL" (ByVal UIParam As Long, _ 
ByVal User As String, ByVal Password As String, ByVal Flags As Long, _ 
ByVal Reserved As Long, Session As Long) As Long 
Private Declare Function MAPILogoff Lib "MAPI32.DLL" (ByVal Session As Long, _ 
ByVal UIParam As Long, ByVal Flags As Long, ByVal Reserved As Long) As Long 
Private Declare Function MAPISendMail Lib "MAPI32.DLL" Alias "BMAPISendMail" _ 
(ByVal Session As Long, ByVal UIParam As Long, Message As MAPIMessage, _ 
Recipient() As MapiRecip, File() As MapiFile, ByVal Flags As Long, _ 
ByVal Reserved As Long) As Long 
Private Declare Function MAPISendDocuments Lib "MAPI32.DLL" (ByVal UIParam As Long, _ 
ByVal DelimStr As String, ByVal FilePaths As String, ByVal FileNames As String, _ 
ByVal Reserved As Long) As Long 
 
 
 
 
Function SendIt(sRecip As String, sTitle As String, sText As String, sFile As String) As Boolean 
    Dim strTemp      As String 
    Dim strError      As String 
    Dim lngIndex      As Long 
    Dim iFileCount As Integer 
     
    Dim mRecip(0) As MapiRecip, mFile() As MapiFile, mMail As MAPIMessage 
    Dim lSess As Long, lRet As Long 
     
    On Error GoTo ErrorHandler 
    SendIt = False 
     
     'Add 2 trailing spaces to the text, this will be the position where the attachment goes to
    sText = sText & "  " 
     
     'Recipient
    With mRecip(0) 
        .Name = sRecip 
        .RecipClass = MAPI_TO 
    End With 
     
     'File to send?
    If sFile <> "" Then 
        ReDim mFile(0) 
        With mFile(0) 
            .FileName = sFile 
            .PathName = sFile 
            .Position = Len(sText) - 1 
            .FileType = "" 
            .Reserved = 0 
        End With 
        iFileCount = 1 
    End If 
     
     'Create Mail
    With mMail 
        .Subject = sTitle 
        .NoteText = sText 
        .Flags = 0 
        .FileCount = iFileCount 
        .RecipCount = 1 
        .Reserved = 0 
        .DateReceived = "" 
        .MessageType = "" 
    End With 
     
     'Post it
     'Logon: User = "" and Password = ""
    lRet = MAPILogon(0, "", "", MAPI_LOGON_UI, 0, lSess) 
    If lRet <> SUCCESS_SUCCESS Then 
        strError = "Error logging into messaging software. (" & CStr(lRet) & ")" 
        GoTo ErrorHandler 
    End If 
     
     'Send the mail to the given recipients with the attached file without showing a dialog
    lRet = MAPISendMail(lSess, 0, mMail, mRecip, mFile, MAPI_NODIALOG, 0) 
    If lRet <> SUCCESS_SUCCESS And lRet <> MAPI_USER_ABORT Then 
        If lRet = 14 Then 
            strError = "Recipient not found" 
        Else 
            strError = "Error sending: " & CStr(lRet) 
        End If 
        GoTo ErrorHandler 
    End If 
     
    lRet = MAPILogoff(lSess, 0, 0, 0) 
     
    SendIt = True 
    Exit Function 
     
ErrorHandler: 
    If strError = "" Then strError = Err.Description 
    Call MsgBox(strError, vbExclamation, "MAPI-Error") 
End Function 
 
 
 
Sub eMailActiveWorkbook() 
    Dim Wb As Workbook 
     
    Application.ScreenUpdating = False 
    Set Wb = ActiveWorkbook 
    Wb.Save 
     
    SendIt "me@here.com", "A new Document", "Hi, read this:", Wb.FullName 
     
    Application.ScreenUpdating = True 
    Set Wb = Nothing 
End Sub