メールを一括送信する方法はウェブ上にいくつも紹介されていましたが、以下のすべての条件を満たすものが見つからなかったのであれこれ組み合わせて実現してみました。

【条件】

・メール送信にはOutlookを使用すること

・メール本文はHTML形式であること

・添付ファイルを複数添付できること

・送信先メールアドレス、企業名、氏名を差し込みできること

あとこれは条件にはしていませんでしたが、結果的に

・添付ファイルを送信先別に変える

・件名を送信先別に変える

もできました（変えずに同じにもできます）。

【環境】

Windows7 / Excel 2013 / Outlook 2013

Windows7 / Excel 2010 / Outlook 2010

で確認済み。その他は確認してないというだけでできないわけではないと思います。

 【手順】

A：必要なファイルを準備する

1：[スタート]ボタン→[コンピューター]→[ローカル ディスク(C:)]と進み、「work」という名前の新しいフォルダーを作ります。

2：「work」フォルダーの中に添付したいファイルをすべて入れます。

3：アウトルックを立ち上げ、[新しい電子メール]をクリックしてメール本文を入力します。テキスト形式でもHTML形式でも構いません。

このとき、のちのち差し込みたい（送信先ごとに変えたい）箇所を□□や●●などの記号にしておきます。

4：[ファイル]→[名前を付けて保存]と進み、「test」という名前を付けて先ほどの「work」フォルダー内に保存します。このときファイルの種類を「Outlook テンプレート(*.oft)」にします。

5：エクセルを起動して、

・宛先

・企業名

・氏名

・件名

・添付ファイル1

・添付ファイル2

を1行目に記載します。この文字列はのちほど記載するコードと連動していますので変更しないでください。

2行目以降に実際に送る内容を記載していきます。

※同姓同名の人がいた場合、下に記載された方のみが有効になります。

※添付するファイルを人によって変更することはできますが、添付するファイルの数は全員共通でなければ動きません。この例では全員2ファイルを添付します。添付数を変える方法は後述します。

編集が終わったら、好きな名前を付けてエクセルを保存します。

ここまでで「A：必要なファイルを準備する」は完了です。

B：メッセージファイルを生成する

1：先ほど保存したエクセルファイルを開き、[ファイル]→[オプション]と進みます。

[リボンのユーザー設定]を選択し、「開発」にチェックが入っているか確認します。入っていなかったらチェックを入れ、「OK」で設定を保存します。

2：ツールバーに「開発」が追加されるので、[開発]→[Visual Basic]と進みます。

3：「Sheet1(Sheet1)」をダブルクリック

4：出てきたウインドウに以下の内容を貼り付けます。

Enum 列
宛先 = 1
企業名
氏名
件名
添付ファイル1
添付ファイル2
End Enum

Sub メール作成()
Dim ol As New Outlook.Application
Dim m As mailItem

Dim MaxRow: MaxRow = Range("A1").End(xlDown).Row
For i = 2 To MaxRow
Set m = ol.CreateItemFromTemplate("c:\work\test.oft")
m.To = Cells(i, 列.宛先).Value
m.Subject = Cells(i, 列.件名).Value
m.Attachments.Add "c:\work\" & Cells(i, 列.添付ファイル1).Value
m.Attachments.Add "c:\work\" & Cells(i, 列.添付ファイル2).Value

m.HTMLBody = Replace(m.HTMLBody, "□□", Cells(i, 列.企業名).Value)
m.HTMLBody = Replace(m.HTMLBody, "●●", Cells(i, 列.氏名).Value)
m.SaveAs "c:\work\" & Cells(i, 列.氏名).Value & ".msg"
Next i
End Sub

5：[ツール]→[参照設定]と進み、「Microsoft Outlook 15.0 Object Library」にチェックが入っているか確認します。

入っていない場合は、下の方から探してチェックを入れ「OK」で保存します。

※「15.0」の部分は違う数字の場合がありますが、それで問題ありません

6：[実行]→[Sub/ユーザーフォームの実行]と進みます。

※この画面が出た場合は「実行」をクリック

7：「work」フォルダー内にメッセージファイルが生成されます。

 

 ここまでで「メッセージファイルを生成する」は完了です。

C：メールを一括送信する

1：アウトルックの「送信トレイ」に、先ほど生成されたメッセージファイルをドラッグ＆ドロップします。

2：[ファイル]→[オプション]→[リボンのユーザー設定]と進み、エクセルの時と同じ要領で「開発」にチェックが入っているか確認します。入っていなかったらチェックを入れ、「OK」で設定を保存します。

3：ツールバーに「開発」が追加されるので、[開発]→[Visual Basic]と進み、「ThisOutlookSession」をダブルクリック。

4：表示されたウインドウに以下のコードを貼り付けます。

Public Sub SendSelected()
Dim objMail As MailItem

For Each objMail In ActiveExplorer.Selection
objMail.Send
Next
End Sub

5：アウトルックに戻り、「送信トレイ」内にあるメールをすべて選択します。

6：Visual Basicに戻り、[実行]→[Sub/ユーザーフォームの実行]と進みます。

※この画面が出たら「実行」をクリック

これで送信トレイの中のメールが順次送信されていくはずです。

【ちょっとアレンジ】

・添付ファイルの数を変える方法

エクセルのVisual Basicに書いたコードの下記部分をいじってください。

Enum 列
宛先 = 1
企業名
氏名
件名
添付ファイル1
添付ファイル2
End Enum

Sub メール作成()
Dim ol As New Outlook.Application
Dim m As mailItem

Dim MaxRow: MaxRow = Range("A1").End(xlDown).Row
For i = 2 To MaxRow
Set m = ol.CreateItemFromTemplate("c:\work\test.oft")
m.To = Cells(i, 列.宛先).Value
m.Subject = Cells(i, 列.件名).Value
m.Attachments.Add "c:\work\" & Cells(i, 列.添付ファイル1).Value
m.Attachments.Add "c:\work\" & Cells(i, 列.添付ファイル2).Value

m.HTMLBody = Replace(m.HTMLBody, "□□", Cells(i, 列.企業名).Value)
m.HTMLBody = Replace(m.HTMLBody, "●●", Cells(i, 列.氏名).Value)
m.SaveAs "c:\work\" & Cells(i, 列.氏名).Value & ".msg"
Next i
End Sub

添付ファイルが1つでいい場合は赤字部分を消してください。

添付ファイルを増やしたい場合は、

添付ファイル1
添付ファイル2

添付ファイル3

と

m.Attachments.Add "c:\work\" & Cells(i, 列.添付ファイル1).Value
m.Attachments.Add "c:\work\" & Cells(i, 列.添付ファイル2).Value

m.Attachments.Add "c:\work\" & Cells(i, 列.添付ファイル3).Value

といった感じで追記し、その分の列をエクセルに追記すればOKです。

以上、あくまでまたいつか自分がやる時のためのメモ。

ここに書いた内容を実行される場合はあくまで自己責任でお願いします。

何か被害があった場合、いかなる理由であっても保障いたしかねます。

摘自http://www.bnm.tokyo/entry/2016/05/02/125815