ExcelマクロでOutlookの送信相手ごとに本文を変更する方法（合否通知送付サンプル有）
こんにちは、副業エンジニアのてつをです。今回は、前回の続編ということで、Excelマクロで送信相手ごとに本文を変更する方法をご紹介します。前回作成したExcelマクロを改良して作成するので、前回の記事をご覧になられてない方はまずこちら（【最新】ExcelマクロでOutlookのメールを送信者指定して送信する方法）をご覧ください。もちろん、今回もコードをコピーしたらそのまま利用できるような形でご紹介させていただきます。
では早速、本題に入っていきましょう。
目次
-
【変更箇所①】送信者リストに合格・不合格を識別する列を追加する
-
【変更箇所②】合格者用の本文と不合格者用の本文を作成する
-
Excel【変更箇所③】合格者・不合格者で利用する本文が変わるようVBAのコードを修正する
1．【変更箇所①】送信者リストに合格・不合格を識別する列を追加する
まず初めに、送信者リストに載っている一人一人に対して、合格か不合格かを判断できるようリストシートに「合否」列を追加します。後々、この「合否」列を見て合格者には合格通知を、不合格者には不合格通知を送れるようにします。
では、具体的に修正する箇所を確認していきます。
リストシートを開き、K列に「合否」列を追加します。また、それぞれの人に対して、「合格」か「不合格」を入力します。以下の図のように記載できていれば問題ないです。
2．【変更箇所②】合格者用の本文と不合格者用の本文を作成する
続いて、合格者・不合格者に対して送付するメールの本文を作成します。方法としては、メールシートに合格者向けの本文を不合格者向けの本文の２つを準備します。
では、具体的に修正する箇所を確認していきます。メールシートのB3セルには既にメール本文のサンプルがあったかと思うので、こちらを合格者向けの本文に書き替えます。一方、不合格者用のメール本文も必要であるため、C２セルに不合格者用の本文も作成します。最後に、タイトルも今回の例題に合わせて試験結果送付と変更すればOKです。サンプルとして、修正後のメールシートを以下に示します。
3．【変更箇所③】合格者・不合格者で利用する本文が変わるようVBAのコードを修正する
いよいよ最後の作業です。メール本文が合格者・不合格者で切り替わるようにVBAのコードを書き換えていきます。書き換える場所は、なんとたったの１か所です。
具体的に、修正する場所を確認していきます。まず、以下の記載を探してみてください。
この１行を以下の様に変更してください。
なんと、作業は以上です！
念のため書き換えたコードの説明をしておくと、新たに作成していただいた合否列に”合格”と記載されている人にはメール本文「B３」を使用し、それ以外の人（不合格の人）にはメール本文「C３」を利用するようになっています。
参考までに、サンプルとして全コードも掲載しておきます。
Sub Savebatchmail()
'---コード1｜定義
Dim toaddress, ccaddress, bccaddress As String '変数設定：To宛先、cc宛先、bcc宛先
Dim subject, mailBody, credit As String '変数設定：件名、メール本文、クレジット、添付
Dim outlookObj As Object 'Outlookで使用するオブジェクト生成
Dim mailItemObj As Object 'Outlookで使用するオブジェクト生成
Dim olkApp
Dim acctToSend
SEND_ACCOUNT = Worksheets("メール").Range("B1")
Dim MaxRow: MaxRow = Worksheets("リスト").Range("E2").End(xlDown).Row
Dim wsMail As Worksheet
Set wsMail = ThisWorkbook.Sheets("メール")
Dim wsList As Worksheet
Set wsList = ThisWorkbook.Sheets("リスト")
'---コード2｜差出人、本文、署名を取得する---
Dim I As Integer
Dim j As Integer
'Dim title As Range
Dim step1 As String
For I = 2 To MaxRow
If wsList.Cells(I, 1) <> "NG" And wsList.Cells(I, 1) <> "済" Then
toaddress = wsList.Cells(I, 5).Value 'To宛先
'ccaddress = Range("B3").Value 'cc宛先
'bccaddress = Range("B4").Value 'bcc宛先
subject = wsMail.Range("B2").Value '件名
If wsList.Cells(I, 11).Value = "合格" Then 'メール本文
mailBody = wsMail.Range("B3").Value '合格の場合
Else
mailBody = wsMail.Range("C3").Value '不合格の場合
End If
mailBody = Replace(mailBody, "■■", wsList.Cells(I, 4).Value) '会社名
mailBody = Replace(mailBody, "○○", wsList.Cells(I, 3).Value) '氏名
credit = wsMail.Range("B4").Value '著名
'---コード3｜メールを作成して、差出人、本文、署名を入れ込む---
Set outlookObj = CreateObject("Outlook.Application")
Set mailItemObj = outlookObj.CreateItem(olMailItem)
' Outlook のオブジェクトを取得
Set olkApp = CreateObject("Outlook.Application")
Set acctToSend = olkApp.Session.Accounts.Item(SEND_ACCOUNT)
Set mailItemObj.SendUsingAccount = acctToSend '差出人をセット
mailItemObj.BodyFormat = 3 'リッチテキストに変更
mailItemObj.To = toaddress 'to宛先をセット
'mailItemObj.CC = ccaddress 'cc宛先をセット
'mailItemObj.BCC = bccaddress 'bcc宛先をセット
mailItemObj.subject = subject '件名をセット
'---コード4｜メール本文を改行する
mailItemObj.Body = mailBody '& vbCrLf & vbCrLf & credit 'メール本文 改行 改行 クレジット
'---コード5｜自動で添付ファイルを付ける---
'Dim attached As String
'Dim myattachments As Outlook.Attachments 'Outlookで使用するオブジェクト生成
'Set myattachments = mailItemObj.Attachments
'attached = Range("B6").Value '添付ファイル
'myattachments.Add attached
'---コード6｜メールを送信する---
mailItemObj.Save '下書き保存
'mailItemObj.Display 'メール表示(ここでは誤送信を防ぐために表示だけにして、メール送信はしない)
wsList.Cells(I, 1) = "済" 'メールを作成したら、1行目に済を入れる
End If
Next I
'---コード7｜outlookを閉じる(オブジェクトの解放)---
Set outlookObj = Nothing
Set mailItemObj = Nothing
Set olkApp = Nothing
Set acctToSend = Nothing
End Sub
修正箇所は以上となるので、試しにメール作成ボタンを押してみてください。下書きに、以下の様に合格者に対しては合格通知を、不合格者に対しては不合格通知がちゃんと作成できていますでしょうか。
本記事は以上となります。
今後、様々なパターンを記事にまとめていこうと考えておりますので、このような記事も書いてほしいなどありましたら是非お問い合わせください。
宜しくお願い致します。
以上。