ねぇもりさん、会社で毎日たくさんメールを出す作業があるんだ。ラクにできる方法ないかなぁ
もり
一斉送信はできないの？？
宛先ごとにメールの文面を変えるから、一件ずつ個別に送信しなきゃいけないんだ
もり
なるほどね～それならVBAでツールを作っちゃおう
メール本文がまったく同じ内容であればToやBccなどで一斉送信できますが、相手によってメールの文面を変えたい場合は、一通ずつメールを作成して個人宛に送信する必要がありますよね。
Excelシートに用意したデータを元に、Outlookの下書きメールを一括作成するマクロを紹介します。
作成した下書きメールは、下記のいずれかの処理ができます。
- 画面に表示させる
- 画面に表示はさせず、直接「下書き」フォルダに保存する
- 画面に表示はさせず、直接「送信」する
スポンサーリンク
Contents
VBAでOutlookの下書きメールを一括作成する
※この記事はVBAの基本操作を習得している方向けに書いているので、全般的な解説は省略しています。
【事前準備】Excelシートにデータを用意する
下記のようなフォーマットを用意します（※ご自身の業務要件に応じてフォーマットは調整してください）
シート名は「mail」としておきます。
- A～E列：宛先と宛先ごとの情報
- J列：固定情報
J列の「本文」は「ひな形」です。宛先毎に変更したい箇所を（）全角かっこでくくっています。
ひな形のこの部分をマクロで置き換えます。
- （氏名）：C列の値に置換
- （使用日）：D列の値に置換
- （金額）：E列の値に置換
ソースコード
下記を標準モジュールに貼り付けます。
- 「ツール」→「参照設定」で「Microsoft Outlook XX.0 Object Library」を使用
- 事前にOutlookを起動しておき、mainプロシージャを実行
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 |
Enum col '列番号を定義 宛先 = 1 複写 = 2 氏名 = 3 使用日 = 4 金額 = 5 メール = 10 End Enum Sub main() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets("mail") 'Outlookオブジェクトの作成 Dim OutlookObj As Outlook.Application Set OutlookObj = New Outlook.Application Dim r As Long, lastRow As Long lastRow = ws.Cells(1, 1).End(xlDown).Row For r = 2 To lastRow 'メールアイテムオブジェクト作成 Dim mailItemObj As Outlook.MailItem Set mailItemObj = OutlookObj.CreateItem(olMailItem) 'メール本文の文字列を作成 Dim mailBody As String mailBody = CreateMailBody(ws, r) 'メールアイテム作成 With mailItemObj 'Outlookに複数アカウントを設定している場合、送信元アカウントを指定できる .SendUsingAccount = Session.Accounts("メールアドレスを記述") '省略可 .To = ws.Cells(r, col.宛先).Value 'Toを設定 .CC = ws.Cells(r, col.複写).Value 'CCを設定 .Subject = ws.Cells(1, col.メール).Value '件名を設定 .body = mailBody '本文を設定 End With '下書きメールアイテムを表示 mailItemObj.Display '次のメールアイテムを作成するためいったん破棄 Set mailItemObj = Nothing Next r End Sub ' 機能：Excelシート上の指定行番号のメール本文を作成する Function CreateMailBody(ws As Worksheet, r As Long) As String Dim sName As String, DayOfUse As String, price As Long sName = ws.Cells(r, col.氏名).Value DayOfUse = ws.Cells(r, col.使用日).Value price = ws.Cells(r, col.金額).Value Dim sign As String '署名 sign = ws.Cells(12, col.メール).Value Dim body As String 'メール本文 body = ws.Cells(2, col.メール).Value '初期値を設定 body = Replace(body, "（氏名）", sName) body = Replace(body, "（使用日）", DayOfUse) body = Replace(body, "（金額）", price) body = body & vbCrLf & vbCrLf & sign '末尾に署名を付与 CreateMailBody = body End Function |
【実行結果】下書きメールが作成される
Excelシートの行数分、下書きメールが作成されます。
【参考】下書きフォルダに保存する・直接送信する
上記で紹介したコードは「下書きアイテムの作成」ですが、「送信」or「保存」もマクロで実行することができます。
43行目のメソッドを書き換えます。
・下書きフォルダに保存する場合
mailItemObj.Display → mailItemObj.Save
・直接送信する場合（※必ず事前にテストして、誤送信のないようお気をつけください）
mailItemObj.Display → mailItemObj.Send
以上です！
ねぇもりさん、添付ファイルも付けられないかなぁ？
もり
できるよ～！次の記事で紹介するね！
【VBAでOutlook操作】複数ファイルを添付できる！下書きメールを一括作成するマクロExcelシートのデータを元に、Outlookの下書きメールを一括作成するマクロです。キーワードに一致する複数ファイルをまとめて添付できるのがポイントです
...
スポンサーリンク
スポンサーリンク
