ExcelVBAでOutlookからメール送信するプログラムを解説します。

はじめに
添付ファイルを付けて送信
複数のアカウントを切り替える
メール送信プログラム
まとめ
1. 関連記事:

はじめに

　前回の記事では、Outlookからメール送信する基本的なプログラムを解説しました。
今回は、添付ファイルを付けて送信したり、複数のアカウントを切り替えて送信する機能を付けていきます。

　今回のプログラムは以下からダウンロードできます。プログラムの動作に関する責任は一切負えません。プログラムの内容をよく理解していただき、利用する場合は自己責任でお願いいたします。m(_ _)m

添付ファイルを付けて送信

　メール送信の際に添付ファイルを付けるには、MailItem オブジェクトに.Attachments.Add として添付ファイルのパスを渡せばOKです。今回は上記のように「ファイル選択」ボタンを設けて、セルにパスを入力できるようにしました。

　「ファイル選択」ボタンを押すとファイル選択ダイアログを出してユーザーに選択してもらう形になります。ボタンを押したときのコードは以下の様になります。

Sub getMyFileName()
    Dim vfilename As Variant
    ChDir ThisWorkbook.Path      '開くフォルダを指定したい時
    vfilename = Application.GetOpenFilename("全てのファイル,*.*")
    If vfilename = False Then
        Exit Sub
    End If
   
    ActiveSheet.Range("E17") = vfilename
End Sub

　「ファイル選択」ボタンのマクロの登録で、上のプログラムを指定します。

　ファイル選択ダイアログが表示され、ファイルを選択すると所定のセルにパスが表示されます。

複数のアカウントを切り替える

　Outlookでは、複数のアカウントを設定する事ができます。送信元のアカウントは既定値があり、何も指定しない場合は既定値のアカウントを使う仕様になっています。
　今回はボタンでアカウントを選択できるようにしてみます。

　アカウント情報は、メール送信のプログラムとは別にOutlookから取得しておくようにします。「アカウント取得」ボタンを押すとOutlookからアカウントを取得しますが、プログラムは以下の様になります。

'アカウント情報をセット
Sub setAccountList()
    Dim OutlookApp As Outlook.Application
    Dim myMail As Outlook.MailItem
    Dim i As Long, aStr As String

    On Error GoTo ErrMsg
        
    Set OutlookApp = New Outlook.Application
    Set myMail = OutlookApp.CreateItem(olMailItem) 'olMailItem = MailItem オブジェクト

    aStr = ""
    'アカウントのリストをカンマで区切った文字列にする
    For i = 1 To myMail.Session.Accounts.Count
        aStr = aStr & "," & myMail.Session.Accounts(i)
    Next i
    aStr = Mid(aStr, 2) '先頭のカンマを取り除く
    
    'E21セルに入力規則のリストをセットする
    With ActiveSheet.Range("E21").Validation
        .Delete
        .Add Type:=xlValidateList, _
             Operator:=xlEqual, _
             Formula1:=aStr
    End With
    
    '1番目が既定値に設定されているので最初に表示しておく
    ActiveSheet.Range("E21") = myMail.Session.Accounts(1)
    
    Exit Sub
ErrMsg:
    MsgBox "Error：" & Err.Number & vbCrLf & Err.Description
End Sub

　Outlookからアカウントの情報を取得するにはメール送信の時と同じようにOutlookのオブジェクトを使います。
MailItem オブジェクトの Session.Accounts に情報がありますので、複数のアカウントをカンマ付きの文字列にします。
　次に所定のセル（E21セル）の入力規則のリストに設定します。
　最後に、アカウントリストの１番目に来るのが既定値なので、その値をセルに表示させるようにしています。

　尚、今回はエラー処理を追加しています。冒頭で On Error GoTo ErrMsg としておくと途中エラーが発生した時にErrMsgラベルに飛びます。（ラベル名は自由に設定できます）
エラーの内容はErrオブジェクトで取得できます。Err.Number はエラー番号、Err.Description はエラーメッセージになります。

メール送信プログラム

添付ファイルと、アカウント選択機能を追加したメール送信プログラムは以下の様になります。

'添付ファイル、アカウント選択機能付き
Sub SendMyEmails3()
    Dim OutlookApp As Outlook.Application
    Dim myMail As Outlook.MailItem
    Dim sh As Worksheet
    Dim i As Long

    On Error GoTo ErrMsg

    Set OutlookApp = New Outlook.Application
    Set sh = Worksheets("Sheet3")       '/// シートを指定 ///
    
    For i = 3 To 9
        If sh.Cells(i, "C") <> "" Then
            Set myMail = OutlookApp.CreateItem(olMailItem) 'MailItem オブジェクト
            With myMail
            .To = sh.Cells(i, "C")     'メールの宛先
            .subject = sh.Range("E3")   'メールの件名
            .BodyFormat = olFormatPlain     'メールの形式
            .Body = Replace(sh.Range("E5"), "[[[氏名]]]", sh.Cells(i, "B"))   'メールの本文
            
            '添付ファイル
            If sh.Range("E17") <> "" Then
                .Attachments.Add sh.Range("E17").Text
            End If

            'アカウントをセット
            If sh.Range("E21").Text <> "" Then
                .SendUsingAccount = OutlookApp.Session.Accounts.Item(sh.Range("E21").Text)
            End If
            
            .Display    '新規メール画面を表示
            '.Send  'メールを送信
            
            End With
        End If
    Next i
    
    MsgBox "終了しました。"
    Exit Sub
    
ErrMsg:
    MsgBox "Error：" & Err.Number & vbCrLf & Err.Description
End Sub

　こちらのプログラムでもエラー処理を付けています。もし添付ファイルに異常があったばあい、以下のようなメッセージが表示されます。