'MAPISendMail を利用するサンプルマクロ(Excel95)

Option Explicit

Const SUCCESS_SUCCESS = 0
Const MAPI_USER_ABORT = 1
Const MAPI_E_FAILURE = 2
Const MAPI_E_LOGIN_FAILURE = 3
Const MAPI_E_DISK_FULL = 4
Const MAPI_E_INSUFFICIENT_MEMORY = 5
Const MAPI_E_BLK_TOO_SMALL = 6
Const MAPI_E_TOO_MANY_SESSIONS = 8
Const MAPI_E_TOO_MANY_FILES = 9
Const MAPI_E_TOO_MANY_RECIPIENTS = 10
Const MAPI_E_ATTACHMENT_NOT_FOUND = 11
Const MAPI_E_ATTACHMENT_OPEN_FAILURE = 12
Const MAPI_E_ATTACHMENT_WRITE_FAILURE = 13
Const MAPI_E_UNKNOWN_RECIPIENT = 14
Const MAPI_E_BAD_RECIPTYPE = 15
Const MAPI_E_NO_MESSAGES = 16
Const MAPI_E_INVALID_MESSAGE = 17
Const MAPI_E_TEXT_TOO_LARGE = 18
Const MAPI_E_INVALID_SESSION = 19
Const MAPI_E_TYPE_NOT_SUPPORTED = 20
Const MAPI_E_AMBIGUOUS_RECIPIENT = 21
Const MAPI_E_MESSAGE_IN_USE = 22
Const MAPI_E_NETWORK_FAILURE = 23
Const MAPI_E_INVALID_EDITFIELDS = 24
Const MAPI_E_INVALID_RECIPS = 25
Const MAPI_E_NOT_SUPPORTED = 26

Const MAPI_ORIG = 0
Const MAPI_TO = 1
Const MAPI_CC = 2
Const MAPI_BCC = 3
Const MAPI_UNREAD = 1
Const MAPI_RECEIPT_REQUESTED = 2
Const MAPI_SENT = 4

Const MAPI_LOGON_UI = &H1
Const MAPI_NEW_SESSION = &H2
Const MAPI_DIALOG = &H8
Const MAPI_UNREAD_ONLY = &H20
Const MAPI_ENVELOPE_ONLY = &H40
Const MAPI_PEEK = &H80
Const MAPI_GUARANTEE_FIFO = &H100
Const MAPI_BODY_AS_FILE = &H200
Const MAPI_AB_NOMODIFY = &H400
Const MAPI_SUPPRESS_ATTACH = &H800
Const MAPI_FORCE_DOWNLOAD = &H1000
Const MAPI_OLE = &H1
Const MAPI_OLE_STATIC = &H2

Type MapiRecipDesc
    ulReserved As Long
    ulRecipClass As Long
    lpszName As Long
    lpszAddress As Long
    ulEIDSize As Long
    lpEntryID As Long
End Type

Type MapiFileDesc
    ulReserved As Long
    flFlags As Long
    nPosition As Long
    lpszPathName As Long
    lpszFileName As Long
    lpFileType As Long
End Type

Type MapiMessage
    ulReserved As Long
    lpszSubject As String
    lpszNoteText As String
    lpszMessageType As String
    lpszDateReceived As String
    lpszConversationID As String
    flFlags As Long
    lpOriginator As Long
    nRecipCount As Long
    lpRecips As Long
    nFileCount As Long
    lpFiles As Long
End Type

Type TLongBuffer
    Item(0 To 63) As Long
End Type

Declare Function MAPISendMail Lib "MAPI32.DLL" ( _
    ByVal hSession As Long, ByVal ulUIParam As Long, _
    ByRef lpMessage As MapiMessage, ByVal flFlags As Long, _
    ByVal ulReserved As Long) As Long

Declare Function lstrcpyPtr Lib "kernel32" Alias "lstrcpyA" ( _
    ByRef lpString1 As Any, ByVal lpString2 As String) As Long

Sub Test_SendMail()
    Dim hSession As Long
    Dim utMAPIMsg As MapiMessage
    Dim utMAPIFile As MapiFileDesc
    Dim utMAPIRecip1 As MapiRecipDesc
    Dim lpRecip1 As Long
    Dim lpFile1 As Long
    Dim lpStrPtr(1 To 4) As Long
    Dim lpBuffer(1 To 4) As TLongBuffer
    Dim iRet As Long
    Dim i As Long

    If Application.MailSystem <> xlMAPI Then
        MsgBox "MAPIがセットアップされていません。", vbExclamation
        Exit Sub
    End If

    If IsNull(Application.MailSession) Then
        Application.MailLogon
    End If

    hSession = CLng("&h" & Application.MailSession)

    lpRecip1 = lstrcpyPtr(utMAPIRecip1, Chr$(0))
    lpFile1 = lstrcpyPtr(utMAPIFile, Chr$(0))

    For i = 1 To 4
        lpBuffer(i).Item(0) = 0
    Next

    lpStrPtr(1) = lstrcpyPtr(lpBuffer(1), "TO_Name")
    lpStrPtr(2) = lstrcpyPtr(lpBuffer(2), "SMTP:TO_NAME@domain")
    lpStrPtr(3) = lstrcpyPtr(lpBuffer(3), "C:\My Documents\Book1.xls")
    lpStrPtr(4) = lstrcpyPtr(lpBuffer(4), "Book1")

    With utMAPIRecip1
        .ulReserved = 0
        .ulRecipClass = MAPI_TO
        .lpszName = lpStrPtr(1)
        .lpszAddress = lpStrPtr(2)
    End With

    With utMAPIFile
        .ulReserved = 0
        .nPosition = -1
        .lpszPathName = lpStrPtr(3)
        .lpszFileName = lpStrPtr(4)
    End With

    With utMAPIMsg
        .flFlags = 1
        .lpszSubject = "Test Mail"
        .lpszNoteText = "Test Message"
        .lpOriginator = 0
        .nRecipCount = 1
        .lpRecips = lpRecip1
        .nFileCount = 1
        .lpFiles = lpFile1
    End With

    iRet = MAPISendMail(hSession, 0, utMAPIMsg, MAPI_DIALOG, 0)
    If iRet <> SUCCESS_SUCCESS Then
        MsgBox "エラーが発生しました。", vbExclamation
    End If

    If MsgBox("ログオフしますか?", vbYesNo Or vbQuestion) = vbYes Then
        Application.MailLogoff
    End If

End Sub