Attribute VB_Name = "ModuleSendWithOutlook"
Option Explicit


Public Sub SendWithOutlook( _
    ByVal fromAddress As String, _
    ByVal toAddress As String, _
    ByVal subjectText As String, _
    ByVal bodyText As String, _
    ByVal attachmentPath As String)

    Dim outlookApp As Object
    Dim mailItem As Object
    Dim sendAccount As Object
    Dim account As Object

    If Dir$(attachmentPath) = "" Then
        Err.Raise vbObjectError + 1, , _
            "添付ファイルが見つかりません：" & attachmentPath
    End If

    Set outlookApp = CreateObject("Outlook.Application")

    For Each account In outlookApp.Session.Accounts
        If StrComp(Trim$(account.SmtpAddress), _
                   Trim$(fromAddress), vbTextCompare) = 0 Then
            Set sendAccount = account
            Exit For
        End If
    Next

    If sendAccount Is Nothing Then
        Err.Raise vbObjectError + 2, , _
            "Outlookに送信元アカウントがありません：" & fromAddress
    End If

    Set mailItem = outlookApp.CreateItem(0)

    With mailItem
        Set .SendUsingAccount = sendAccount
        .To = toAddress
        .subject = subjectText
        .body = bodyText
        .attachments.Add attachmentPath
        .Send
    End With
End Sub