【EXCEL：VBA】宛先を変えながら同じ本文のメール下書きを作成したい

この記事では、EXCELで大量のメール下書きを作成する方法について説明します。

メール下書き作成まで自動で行い、中身をチェックしてから最後の送信ボタンを押す形になります。

しかも、一度宛先を登録しておけば、メール件名と本文を書き換えれば、何度でも使うことができます。

これまでは、コピーして貼り付けて、コピーして貼り付けて、とやっていたと思いますが、

最初に設定さえすれば簡単に大量のメールを作成することができるようになります。

それでは、EXCELで大量メール作成ツールを作成していきましょう。

困っている女性

同じ本文のメールを大量に作成するのに疲れたわ・・・。

メールを1つ作成して、BCCに大量の宛先をいれたら簡単ですよ。

解決する男性

困っている女性

それでは、送り先の相手の名前を入れることができないから、ダメなの。

困っている女性

本文は同じでも、○○様って最初に入れたいからその方法じゃ、できない。

それなら、VBAを使えばボタン1つ押すだけで、相手の名前を入れながらたくさんの宛先にメールを送ることができるよ。

解決する男性

困っている女性

それって、添付ファイルもつけれる？

もちろんだよ、CCやBCC、添付ファイルも自由自在に変えれるよ。

解決する男性

困っている女性

それそれ、早く教えてよ。

大量メール作成ツールに必要なものを、1つ1つ順番に説明していきます。

１．メール作成に必要な情報一覧を準備する

メール作成に必要な情報を記入できるように、表を作成します。

「メール下書き作成」シートを作成する

メール下書き作成シートを用意する

「メール下書き作成」という名前のシートを作成します。
1行目に「メール件名」、「メール本文」のタイトル行を作成します。
2行目に「メール件名」、「メール本文」を入力する欄を作成します。
3行目に「宛先一覧」というタイトル行を作成します。
4行目に「NO」、「会社名」、「個人名」、「敬称」、「メールアドレス」、「CCアドレス」、「BCCアドレス」、「添付ファイル」、「対象」のタイトル行を作成します。
5行目以降には、実際の各情報を入力する欄を作成します。

「メール下書き作成」シートの入力方法

「メール件名」欄には、送りたいメールの件名を1行で入力します。

「メール本文」欄には、複数行で相手の心に届くメッセージを入力します。

「NO」欄には、1からの連番を入力します。この数字が入力されていることで、宛先情報が入力されている行として判断に使います。

ですから、宛先情報を入力した行の「NO」欄には、必ず数字を入力してください。

「会社名」、「個人名」、「敬称」欄を入力すると、以下の画像のように「メール本文」欄に入力した文章の前に付加します。

ですから、必ず入力するようにしてください。そうすれば、メール1つ毎に相手の会社名と名前と敬称を切替えることができます。

作成するメールサンプル

「メールアドレス」欄は、送りたい相手のメールアドレスを入力してください。

もちろん、必須入力欄です。

「CCアドレス」、「BCCアドレス」欄は、入力しても良いですし、入力しなくても良いです。

「BCCアドレス」欄は、ご自身の上司などを入力しておけば、上司との情報共有として利用できます。

「添付ファイル」欄は、添付ファイルが必要な場合のみ入力します。

添付したいファイルが保存されているファイルパスを入力してください。

最後の「対象」欄は、実際にメールを作成したい行に”○”を入力します。

“○”でなくてもよいので、なにか入力してあれば、メール作成対象と認識します。

なぜ「対象」欄を用意したかについて、説明します。

今後メールを送る可能性がある人をすべて宛先一覧に入力しておきます。

でも、今回のメールは全員に送る必要がない場合があったときに、「対象」欄を空にしておけばメール作成から除外できます。

なので、「メール件名」、「メール本文」、「対象」欄のみ変更すれば、宛先一覧は一切変更する必要がなくなります。

毎回、宛先一覧に追加したり、削除したりする作業ってかなり面倒な作業となりますし、ミスをしやすい作業となります。

そういうわずらわしさをなくすために「対象」欄を用意しました。

２．VBAで大量メール作成機能を記入する

「Microsoft Visual Basic for Applications」を起動します。

VBAプログラムを記入する前編

VBAプログラムを記入する後編

標準モジュールを追加して、以下のソースを書きます。

Public Sub MainProc()
    Dim sht As Worksheet
    Dim objOutlook As Object
    Dim objMail As Object
    Dim nowRow As Integer
    
    '①参照するシートを変数に格納する
    Set sht = ThisWorkbook.Sheets("メール下書き作成")
    
    '②OUTLOOKオブジェクトを変数に格納する
    Set objOutlook = CreateObject("Outlook.Application")
     
    nowRow = 4
    
    Do While True
        '③現在行を次の行に変更する
        nowRow = nowRow + 1
        
        '④NO列が空なら処理を終わる
        If sht.Range("A" & nowRow) = "" Then Exit Do
        
        '⑤対象列に値が入力されていれば、メール下書きを作成する
        If sht.Range("I" & nowRow) <> "" Then
        
            '⑥メールオブジェクトを変数に格納する
            Set objMail = objOutlook.CreateItem(0)
        
            With objMail
            
                '⑦メール件名をセットする
                .Subject = sht.Range("A2").Value
                
                '⑧メール本文をセットする
                .Body = sht.Range("B" & nowRow).Value & vbCrLf & _
                        sht.Range("C" & nowRow).Value & _
                        sht.Range("D" & nowRow).Value & vbCrLf & vbCrLf & _
                        sht.Range("E2").Value
                        
                '⑨メール宛先をセットする
                .To = sht.Range("E" & nowRow).Value
                
                '⑩CCアドレスをセットする（入力されている時のみ）
                If sht.Range("F" & nowRow) <> "" Then
                    .CC = sht.Range("F" & nowRow).Value
                End If
                
                '⑪BCCアドレスをセットする（入力されている時のみ）
                If sht.Range("G" & nowRow) <> "" Then
                   .BCC = sht.Range("G" & nowRow).Value
                End If
                
                '⑫添付ファイルをセットする（入力されている時のみ）
                If sht.Range("H" & nowRow) <> "" Then
                   .Attachments.Add (sht.Range("H" & nowRow).Value)
                End If
             
                '⑬作成したメール下書きを表示する
                .Display
                
            End With
        End If
        
    Loop

    Set objOutlook = Nothing
    
    MsgBox "完了"
End Sub

Public Sub MainProc()

Dim sht As Worksheet

Dim objOutlook As Object

Dim objMail As Object

Dim nowRow As Integer

'①参照するシートを変数に格納する

Set sht = ThisWorkbook.Sheets("メール下書き作成")

'②OUTLOOKオブジェクトを変数に格納する

Set objOutlook = CreateObject("Outlook.Application")

nowRow = 4

Do While True

'③現在行を次の行に変更する

nowRow = nowRow + 1

'④NO列が空なら処理を終わる

If sht.Range("A" & nowRow) = "" Then Exit Do

'⑤対象列に値が入力されていれば、メール下書きを作成する

If sht.Range("I" & nowRow) <> "" Then

'⑥メールオブジェクトを変数に格納する

Set objMail = objOutlook.CreateItem(0)

With objMail

'⑦メール件名をセットする

.Subject = sht.Range("A2").Value

'⑧メール本文をセットする

.Body = sht.Range("B" & nowRow).Value & vbCrLf & _

sht.Range("C" & nowRow).Value & _

sht.Range("D" & nowRow).Value & vbCrLf & vbCrLf & _

sht.Range("E2").Value

'⑨メール宛先をセットする

.To = sht.Range("E" & nowRow).Value

'⑩CCアドレスをセットする（入力されている時のみ）

If sht.Range("F" & nowRow) <> "" Then

.CC = sht.Range("F" & nowRow).Value

End If

'⑪BCCアドレスをセットする（入力されている時のみ）

If sht.Range("G" & nowRow) <> "" Then

.BCC = sht.Range("G" & nowRow).Value

End If

'⑫添付ファイルをセットする（入力されている時のみ）

If sht.Range("H" & nowRow) <> "" Then

.Attachments.Add (sht.Range("H" & nowRow).Value)

End If

'⑬作成したメール下書きを表示する

.Display

End With

End If

Loop

Set objOutlook = Nothing

MsgBox "完了"

End Sub

最後にEXCELを「◯◯◯.xlsm」というような感じでマクロ有効ブック形式で保存します。

３．大量メール作成機能の使い方

それでは、大量メール作成機能の動かし方を説明します。

マクロを起動する

「開発」タブの「マクロ」をクリックします。

実行ボタンをクリックする

先程作成した自作関数「MainProc」が一覧に表示されていますので、選択します。

次に、「実行」ボタンをクリックして大量メール作成を実行します。

しばらく待つと、「対象」欄に”○”が入力された行の情報をもとに、メール下書きが作成されます。

うまく動きましたか？

４．大量メール作成機能のVBAプログラムの説明

それでは、VBAプログラムを説明します。

①参照するシートを変数に格納する

'①参照するシートを変数に格納する
    Set sht = ThisWorkbook.Sheets("メール下書き作成")

1 2	'①参照するシートを変数に格納する Set sht = ThisWorkbook.Sheets("メール下書き作成")

ここでは、このあとの処理で何度も使う「メール下書き作成」シートを変数に格納しています。

そうすることにより、入力するプログラムを短くすることができるからです。

何度も「ThisWorkbook.Sheets(“メール下書き作成”)」と入力するより、「sht」と入力するほうが少なくてすむからです。

②OUTLOOKオブジェクトを変数に格納する

'②OUTLOOKオブジェクトを変数に格納する
    Set objOutlook = CreateObject("Outlook.Application")

1 2	'②OUTLOOKオブジェクトを変数に格納する Set objOutlook = CreateObject("Outlook.Application")

ここでは、OUTLOOKオブジェクトを変数に格納して、このあとの処理で利用できるようにします。

③現在行を次の行に変更する

'③現在行を次の行に変更する
nowRow = nowRow + 1

1 2	'③現在行を次の行に変更する nowRow = nowRow + 1

ここでは、現在行を次の行に変更するため、変数「nowRow」に格納している値＋1を、変数「nowRow」に格納しています。

ループ処理の外側で、変数「nowRow」には4が格納されています。

宛先一覧データは、5行目から入力されているので、ループ処理の内側に入ったときに変数「nowRow」を＋1して、5を格納します。

もちろん、ループしてくると、さらに＋1されて6が格納されます。

というように、対象行を5行目から順番に処理することになります。

④NO列が空なら処理を終わる

'④NO列が空なら処理を終わる
If sht.Range("A" & nowRow) = "" Then Exit Do

1 2	'④NO列が空なら処理を終わる If sht.Range("A" & nowRow) = "" Then Exit Do

ここでは、A列（NO）の対象行に値が入力されているかチェックしています。

変数「nowRow」に5が格納されている場合、セルA5に値が入力されているかチェックします。

NOが入力されていない行が見つかると、メール作成処理を終了します。

⑤対象列に値が入力されていれば、メール下書きを作成する

'⑤対象列に値が入力されていれば、メール下書きを作成する
If sht.Range("I" & nowRow) <> "" Then

1 2	'⑤対象列に値が入力されていれば、メール下書きを作成する If sht.Range("I" & nowRow) <> "" Then

ここでは、I列（対象）に値が入力されているかチェックしています。

変数「nowRow」に5が格納されている場合、セルI5に値が入力されているかチェックします。

対象が入力されている場合、メール作成処理を実行します。

対象が入力されていない場合、次の行に処理が移ります。

⑥メールオブジェクトを変数に格納する

'⑥メールオブジェクトを変数に格納する
Set objMail = objOutlook.CreateItem(0)

1 2	'⑥メールオブジェクトを変数に格納する Set objMail = objOutlook.CreateItem(0)

ここでは、メールオブジェクトを変数に格納して、このあとの処理で利用できるようにします。

⑦メール件名をセットする

'⑦メール件名をセットする
.Subject = sht.Range("A2").Value

1 2	'⑦メール件名をセットする .Subject = sht.Range("A2").Value

ここでは、セルA2に入力されているメール件名を、メールオブジェクトのメール件名欄にセットします。

⑧メール本文をセットする

'⑧メール本文をセットする
.Body = sht.Range("B" & nowRow).Value & vbCrLf & _
        sht.Range("C" & nowRow).Value & _
        sht.Range("D" & nowRow).Value & vbCrLf & vbCrLf & _
        sht.Range("E2").Value

'⑧メール本文をセットする

.Body = sht.Range("B" & nowRow).Value & vbCrLf & _

sht.Range("C" & nowRow).Value & _

sht.Range("D" & nowRow).Value & vbCrLf & vbCrLf & _

sht.Range("E2").Value

ここでは、メールオブジェクトのメール本文欄にメッセージをセットします。

具体的には、対象行のB列に入力されている「会社名」をまずセットします。

次に、C列とD列に入力されている「個人名」と「敬称」を連結して、セットします。

例えば、「山田」と「様」を連結して、「山田様」とセットします。

最後に、セルE2に入力されている「メール本文」をセットします。

⑨メール宛先をセットする

'⑨メール宛先をセットする
.To = sht.Range("E" & nowRow).Value

1 2	'⑨メール宛先をセットする .To = sht.Range("E" & nowRow).Value

ここでは、対象行のE列に入力されているメールアドレスを、メールオブジェクトの宛先にセットします。

⑩CCアドレスをセットする（入力されている時のみ）

'⑩CCアドレスをセットする（入力されている時のみ）
If sht.Range("F" & nowRow) <> "" Then
    .CC = sht.Range("F" & nowRow).Value
End If

'⑩CCアドレスをセットする（入力されている時のみ）

If sht.Range("F" & nowRow) <> "" Then

.CC = sht.Range("F" & nowRow).Value

End If

ここでは、対象行のF列にCCアドレスが入力されている時のみ、メールオブジェクトのCCアドレスにセットします。

⑪BCCアドレスをセットする（入力されている時のみ）

'⑪BCCアドレスをセットする（入力されている時のみ）
If sht.Range("G" & nowRow) <> "" Then
    .BCC = sht.Range("G" & nowRow).Value
End If

'⑪BCCアドレスをセットする（入力されている時のみ）

If sht.Range("G" & nowRow) <> "" Then

.BCC = sht.Range("G" & nowRow).Value

End If

ここでは、対象行のG列にBCCアドレスが入力されている時のみ、メールオブジェクトのBCCアドレスにセットします。

⑫添付ファイルをセットする（入力されている時のみ）

'⑫添付ファイルをセットする（入力されている時のみ）
If sht.Range("H" & nowRow) <> "" Then
    .Attachments.Add (sht.Range("H" & nowRow).Value)
End If

'⑫添付ファイルをセットする（入力されている時のみ）

If sht.Range("H" & nowRow) <> "" Then

.Attachments.Add (sht.Range("H" & nowRow).Value)

End If

ここでは、対象行のH列に添付ファイルのパスが入力されている時のみ、メールオブジェクトに添付ファイルをセットします。

⑬作成したメール下書きを表示する

'⑬作成したメール下書きを表示する
.Display

1 2	'⑬作成したメール下書きを表示する .Display

ここでは、作成したメールオブジェクトを表示させます。

５．プログラムの機能変更（複数添付ファイル対応）

メールに複数ファイルを添付する方法について、質問がありました。

VBAプログラムを変更せずに対応するには、
複数ファイルを圧縮して1つのZipファイルを作成します。

そして、そのZipファイルを添付ファイルとして指定すれば対応可能です。

VBAプログラムを変更すれば、Zipファイルにしなくても複数ファイルを添付可能になります。

それでは、VBAプログラムの変更方法を説明します。

具体的には、⑫のVBAプログラムを変更します。

変更前のVBAプログラム

以下が変更前の⑫のVBAプログラムです。

'⑫添付ファイルをセットする（入力されている時のみ）
If sht.Range("H" & nowRow) <> "" Then
    .Attachments.Add (sht.Range("H" & nowRow).Value)
End If

'⑫添付ファイルをセットする（入力されている時のみ）

If sht.Range("H" & nowRow) <> "" Then

.Attachments.Add (sht.Range("H" & nowRow).Value)

End If

変更後のVBAプログラム

以下が変更後の⑫のVBAプログラムです。

'⑫添付ファイルをセットする（入力されている時のみ）
Dim attachFiles As Variant
Dim i As Integer
If sht.Range("H" & nowRow) <> "" Then

    attachFiles = sht.Range("H" & nowRow)
    attachFiles = Replace(attachFiles, vbCrLf, vbLf)
    attachFiles = Split(attachFiles, vbLf)
    
    For i = 0 To UBound(attachFiles)
        If attachFiles(i) <> "" Then
            .Attachments.Add (attachFiles(i))
        End If
    Next
End If