【ExcelVBA】Outlookメールの作成から一括送信まで

大量の送信先あてメールに手動で添付ファイルを貼り付けて、一件づつ送信するのは相当な手間がかかりますよね。誤送信も起きやすくなります

そんなときの解決策として、ExcelからOutlookでメールを作成し送信することができます
しかも、Excelのセルに貼り付けたデータをもとにメールや添付ファイルを一括送信することが可能です。Outlookを開いていなくても可能なんです

汎用で使えるように考えてみたので是非試してみてください。設定が結構面倒なのでサンプルファイルをご利用いただければと思います

Outlookの一括メール(添付ファイルつき)送信をExcelVBAで実現する方法を解説します

ExcelからOutlookを扱うための設定を再確認しましょう

Outlookで添付ファイルを保存する記事で「参照設定」を行う方法と「Outlook の Application オブジェクト」について説明していますからその部分はこの記事を参照してください

基本的な処理の流れ(フローチャート)を確認

Excelシートに必要な設定を書き込んで準備します

VBAで使うための事前準備

メール送信に必要な項目の確認

・差出人メールアドレス「代理送信の場合設定」(設定しない場合は個人アドレスになる)
・送信先メールアドレス(宛先、CC、BCC)
・添付ファイル
・件名
・メール本文
・重要度
・送信前の確認設定(2021/8/8追加)

もっと細かい設定もありますが、今回は基本的な部分だけで充分でしょう

シートは3つ用意します

・それぞれ画像を用意しましたので確認してください

「送信設定」シート

・添付ファイルを設定するためのシートです。設定完了後ここからスタートさせます
・「フォルダ選択」「ファイル読み込み」ボタンで添付ファイルをセットします
・ここでは5個まで指定できますが拡張可能です(もちろん一個でもOK!)
・「D3」セルに番号を入力して、指定された列にファイル名を取り込みます
ファイルがID別でなく「共通」の場合は手動でコピーしてセットしてください

「Mail設定」シート

「件名」「本文」を入力するシートです
・メール本文は4つのセルに入力可能としています(セル内で改行して広げてください)
メールはHTML形式ですので、フォントのサイズや色の設定、画像の貼付けなどが可能です
・セル「C2」「D2]はVBAでファイル名のIDから自動で読み込むようにしています
・本文1に「D2」の会社名を算式で読み込んで反映させています(不要なら変更を)
・「F2」セルはメールを代理送信で送る場合にアドレスを指定します(指定なしは個人)
・「H2」セルでメールの重要度を変更できます(2=重要、1=普通、3=低い)
「J2」セルで送信確認方法を選択できるように機能を追加しました。(2021/8/8 追記)
新規で「下書き保存」を選択できるようにしています。

「Address」シート

宛先(メールアドレス)リストを設定しておくシートです(右半分に用意しておきます)
・左半分側が送信先の指定です。B4~F4に右表の列番号で必要な部分だけ指定します

シート作成が面倒ならば、サンプルファイルを用意していますので、ダウンロードページへのリンクからからDLしてください

添付ファイル付きメールを一斉送信するVBA

・コードは、いくつかの部分に分かれていますが、記事にはメール送信部分だけ貼り付けます
・その他のコードはサンプルファイルで確認してください

メール送信スタート部分のコード

「フォルダ選択」と「添付ファイルの指定」や「メール件名」「メール本文」「送信先」等すべての事前設定完了後に「送信設定」シートの「スタート」ボタンで起動させます

Option Explicit
Sub 一括送信()
    Dim mybook As Workbook
    Dim i As Long
    Dim lngFileCount As Long
    Dim m As Long
    Dim Msg As String
    Dim mladd As String
    Dim mlcc As String
    Dim mlbcc As String

    Set mybook = ThisWorkbook
    With mybook
        '最初の列のファイル数をカウント
        lngFileCount = Application.CountA(.Sheets("送信設定").Range("C6:C2000"))
        On Error GoTo er

        Call マクロ開始

        i = 6   'ループカウンター初期値(セル6から始まるから)
        Do Until i > 2000   'とりあえず2000で
            If lngFileCount < 0 Then Exit Do
            If .Sheets("送信設定").Cells(i, 1) = 0 Then GoTo nextloop
            lngFileCount = lngFileCount - 1
            With .Sheets("Address")
                mladd = .Cells(i, 3).Value '宛先
                mlcc = .Cells(i, 4).Value   'CCのアドレスを3つセット
                mlcc = mlcc & " ; " & .Cells(i, 5).Value
                mlcc = mlcc & " ; " & .Cells(i, 6).Value
                mlbcc = .Cells(i, 7).Value 'BCCのアドレス
            End With
            '次の処理へ
            Call sendAddMail(i, mladd, mlcc, mlbcc)
nextloop:
            i = i + 1   'カウンターを増やす
        Loop
    End With

    Call マクロ終了
    MsgBox "一括送信が完了しました!", vbInformation, "一括送信終了メッセージ"
    Exit Sub
er:
'エラー処理
    Msg = "エラー番号 " & Str(Err.Number) & Err.Source & _
          " でエラーが発生しました。" & Chr(13) & Err.Description
    MsgBox Msg, , "エラー", Err.HelpFile, Err.HelpContext
    Call マクロ終了
End Sub

・15と21行目で件数を「2000」としていますが必要に応じて変更してください
・「送信設定」シート1列目でファイル数「0」以外を33行目で次の処理へ進めています

メールに添付ファイルを貼り付けて送信するまでのコード

・あわせて、不具合が出ないようにコードを修正しています。(2021/8/17修正)
・送信時の確認方法を選択できるように変更しました。(2021/8/8 追記変更)

'添付ファイルやメール本体をセットする
Sub sendAddMail(i As Long, mladd As String, mlcc As String, mlbcc As String)
    Dim oApp As New Outlook.Application
    Dim oItem As Outlook.MailItem
    Dim mybook As Workbook
    Dim mysh As Worksheet
    Dim strFilename As String
    Dim strFoldName As String
    Dim ret As Long
    Dim n As String
    Dim chk As Long
        
    Set mybook = ThisWorkbook
    Set mysh = mybook.Sheets("Mail設定")
        
    Set oItem = oApp.CreateItem(olMailItem)

    With oItem
        mysh.Range("C2") = mybook.Sheets("Address").Cells(i, 1)
        mysh.Range("B2:D2").Calculate
        .To = mladd     '送信先アドレス
        .CC = mlcc      'CC
        .BCC = mlbcc    'BCC
        '代理送信の場合設定【設定しない場合個人アドレスからの送信になる】
        .SentOnBehalfOfName = mysh.Range("F2")
        .Subject = mysh.Range("B1").Text     '件名
        .Importance = mysh.Range("H2") 'olImportanceHigh  '重要度High=2,Low=0,Normal=1
        '送信方法の確認
        chk = mysh.Range("J2").Value
        
        '添付ファイルをセット
        Dim k As Long
        For k = 3 To 7
            strFoldName = Cells(4, k) & "\"
            n = mybook.Sheets("送信設定").Cells(i, k)
            If n = "" Then GoTo nextloop
            If Dir(strFoldName, vbDirectory) = "" Then
                ret = MsgBox("ファイル設定に誤りがあります。確認後に再実行してください。", _
                                    vbYes, "ファイル一括送信"): Exit Sub
            End If
            strFilename = strFoldName & n       'フルパスのファイル名
             
             '指定ファイルが存在しない場合
            If Dir(strFilename) = "" Then
                ret = MsgBox(n & " は存在しません。このファイルを飛ばして続行しますか。", _
                vbYesNo, "なんでもデータ取得システム")
                If ret = vbYes Then
                    GoTo nextloop
                Else: Exit Sub
                End If
            End If
            
            .Attachments.Add strFilename
nextloop:
        Next k
        
        .BodyFormat = olFormatHTML 'olFormatPlainからHTML形式
        '編集のため一旦表示する
        .Display
    End With
    
    '表示後に本文データをコピペする
    Dim objDoc As Object
    'OutlookへWordEditorでデータを送る(貼る)
    Set objDoc = oApp.ActiveInspector.WordEditor

    mysh.Range("B2:B5").Copy
    With objDoc
        .Windows(1).Selection.Paste
        .Application.Selection.HomeKey Unit:=6 'wdStory 6=文頭に移動
    End With
    Application.CutCopyMode = False

    With oItem
        '送信方法分岐
        Select Case chk
            '画面表示せずに送信する場合は、
            Case 0: .Send
            '下書きに保存する場合は、
            Case 2: '.Save
                    .Close olSave
            '未選択の場合は画面確認にしておく
            Case Else: '.Display
                If chk = 1 Then
                    ret = MsgBox("メールを確認してから送信してください!" _
                            & vbCrLf & "継続しますか?(Cancelで中止)", _
                            vbOKCancel + vbExclamation, "メール確認")
                    If ret = vbCancel Then
                        Call マクロ終了
                        End
                    End If
                ElseIf chk = 2 Then
                End If
        End Select
    End With
    
    Set objDoc = Nothing
    Set oItem = Nothing
    Set oApp = Nothing
    Set mysh = Nothing
    Set mybook = Nothing
    
End Sub

・いよいよここからが、メールにデータを貼り付けていく処理です
・16行目でまず、Outlookインスタンスを起動してMailItemをセットしていきます
・31行目からが添付ファイルを貼り付ける処理です(ファイル数分ループ)
・57行目でメール本文をHTML形式としています(この場合以下の処理が必要)
・59行目で編集のためメールを表示させています。表示させておいてから
・62行目からがメール本文を貼り付ける処理(WordEditor経由で貼り付けます)
・85行目でメッセージボックスを出してVBA処理を一時止めています
【重要」作成済みのメールが送信待機しているので内容を確認後に送信します
(後で送信する場合、下書き保存しておいても良いと思います)
※以下2021/8/8 修正追記(機能追加分)
・29行目で送信前確認方法の選択を取得しています。
・76~94行目で送信前確認方法の選択で処理を分岐するようにしています。
80行目が新規に追加した「下書き保存」の部分です。
・選択がなかった場合は「1」画面表示の動作となるようにしています。

まとめ(おわりに)

基本事項の再確認と感想など

・添付ファイルリストとメールアドレスの表の行位置は揃える
・添付ファイル名の先頭にID番号を入れておく(リストに合わせるため)
「ID」は先頭の数字で判読しています。(アルファベットや記号が先頭にある場合はコードを書き換えないと動作しませんので時間があるときに対応策を考えます)
・「B5」セルの文字「ID」を削除すればファイル名だけは読み込みますけど対応にはなっていません(-_-;)

・単純なメール送信なら簡単(同じファイルの場合など)ですが
・宛先ごとに違うファイルを添付するには少し苦労しました
・HTML形式にこだわったのは、注意書き等「太字」「色文字」を使いたかったから
・HTML形式なら「画像」や「表」「グラフ」などの添付も可能になります
・なるべく汎用的に使えるように考えて組んでいますがまだまだ改善の余地あり
今後手直しした場合、記事とサンプルを更新していきます

今後の記事について

今回の記事はいかがだったでしょうか。お役に立てたなら幸いです(^^;
是非!サンプルがありますので使ってみてください(^^)/
でも、誤送信しないように十分注意してくださいね(^^)


【今後の記事内容はどうしようかなぁ・・・】
・ZIPファイルの作成方法と活用法など
・高速化した「VlookUp関数」のVBAでの活用法を再検討してみたいと思います
・その他「小ネタ」などなど・・・・・
・今後これらのどれかについて記事にしていきたいと思います。ご期待ください(^^)/

サンプルファイルをダウンロードできます(下記リンク先へ)

記事で使用したサンプルファイルがダウンロードできるページを設置しています
こちら(このリンク先)からご利用ください