【業務効率化】Excelでメールを一人一人に自動送信

メール送信マクロ作成の経緯

社内アンケートやリマインドメールの通知では、「同じ内容」のメールを「一人一人」に「大量」に送信する必要があります。この煩わしさを解消するため、先日社内ツールとしてメールの自動配信マクロを作成しました。
ネット上には意外と一人一人複数人にメール送信するためのマクロが公開されていなかったため、今回共有します。
基本的にはスクリーンショットの通りにシート名、シート内容を入力すれば動くと思います。

機能概要: C列「メール送信」欄に丸がついている対象者に、E列「メール設定内容」の内容でメールが送信されます。その際、CCを3人まで指定できるようにしています。

事前準備

Outlookのメールオブジェクトを利用できるようにするため、VBAの「ツール＞参照設定」より「Microsoft Outlook 16.0 Object Library」にチェックを入れてください。

VBA(Visual Basic)の使用方法やマクロの配置方法がわからない場合は、公式のサポートを参照してください。

VBAコード(コピペ用)

'メールを作成する
Sub SendMail()
         
    'メールシートを変数にしておく
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("メール")

    'Outlookアプリケーションを起動
    Dim outlookObj As Outlook.Application
    Set outlookObj = CreateObject("Outlook.Application")
    
    'Outlookメールを作成
    Dim mymail As Outlook.MailItem
    Set mymail = outlookObj.CreateItem(olMailItem)
    
    'CCの宛先をCCリストに追加
    Dim ccList(2) As String
    ccList(0) = ws.Range("E2").Value
    ccList(1) = ws.Range("E3").Value
    ccList(2) = ws.Range("E4").Value
    
    'メール自動送信機能
    Dim i As Long
    For i = 2 To ws.Cells(Rows.Count, 2).End(xlUp).Row　'2行目から最終行まで探索する
        If ws.Cells(i, 3).Value = "〇" Then  'メール送信欄が"〇"の場合にメールを作成する
        
            'メール情報を設定
            mymail.BodyFormat = 1        'テキストに変更
            mymail.To = ws.Cells(i, 2).Value   'To宛先(B列の宛先を一人ずつ指定)
            mymail.CC = Join(ccList, ";")   'CC宛先(CC1~CC3の宛先を同時指定)
            mymail.Subject = ws.Range("E5").Value    '件名
            mymail.Body = ws.Cells(i, 1).Value & "さん" & vbCrLf & vbCrLf & ws.Range("E6").Value & vbCrLf 
            　'本文(ここでは「〇〇さん＜br＞＜br＞メール本文」と設定)
            
            'メール表示
            mymail.Display　'ここでは誤送信を防ぐために表示だけにして、メール送信はしない
    
            'メール保存
            mymail.Save

            'メール送信の確認(ダイアログボックスを表示)
            If MsgBox(ws.Cells(i, 1).Value & "さんにメールを送信しますか？", vbYesNo) = vbYes Then

                'メール送信
                mymail.Send
            End If
        End If
    Next i
    
    Set outlookObj = Nothing
    Set mymail = Nothing
    
End Sub