![](https://www.slt-pgming-21.net/wp-content/uploads/title_olk_adv-1-1024x576.png)
複数の宛先毎に添付ファイル付きメールを作成する
「ExcelVBAからOutlookを使って複数人に自動でメールを送りたい」という質問に回答するシリーズです。
1回目の記事では以下内容を解説しました。
- Excelに入力された宛先を使ってメールを用意したい
- メールの本文内でハイパーリンクを使いたい
- 添付ファイルを用意したい
![EnjoyExcel](https://www.slt-pgming-21.net/wp-content/uploads/cropped-顔.jpg)
前回記事の内容だけでも大抵のことはできる様になります。
今回はより実務に近い内容にチャレンジしていきます。
今回は2回目になります。応用編という事でもう少しテクニカルな事をやってみましょう。
「複数の宛先へのメールを用意する中で宛先ごとに異なるファイルを添付させる」という作業を構築していきます。
先にポイントを提示しておきます。以下3点です。
- 複数(100件程度)の宛先に向けてメールを用意する
- メールの宛先毎に独自の(ユニークな)添付ファイルを作成する
- メールの宛先に合わせてファイルを添付する
一括管理できる様に出来上がったメールは下書きフォルダに格納する事にします。
![EnjoyExcel](https://www.slt-pgming-21.net/wp-content/uploads/EnjoyExcel-3.png)
一斉送信の手前までをマクロで用意します。
ここまでできればメールを送る作業はほとんど自動化することができますよ。
関連書籍
ExcelVBAからOutlookを操作してメールを用意するという一連の流れは一般の書籍でも紹介されています。
![](https://www.slt-pgming-21.net/wp-content/plugins/pochipp/assets/img/pochipp-logo-t1.png)
こちらは電子書籍です。デュアルモニター(デュアルディスプレイ)で作業している方におすすめです。
モニターで書籍を見ながらコードを書くことで効率よく勉強することができます。
![](https://www.slt-pgming-21.net/wp-content/uploads/eye_olk_adv-1-1024x538.png)
Outlookについて
冒頭で紹介したシリーズ1番目の記事内でOutlookについて解説しています。
基本編エクセルVBA×Outlook|メールにハイパーリンク&添付ファイルを用意する
応用編:複数の宛先毎に添付ファイル付きメールを作成する
実際の作業に移ります。まずは作業内容の確認です。冒頭でも紹介した様に以下3つを実現させます。
- 複数(100件程度)の宛先に向けてメールを用意する
- メールの宛先毎に独自の(ユニークな)添付ファイルを作成する
- メールの宛先に合わせてファイルを添付する
事例を用意しました
取引先100社に対してある調査を依頼する為にメールを送りたいです。
メールには取引先ごとに異なる添付ファイルを付ける必要があります。
Aという取引先にはA社が取り扱っている品番、品名などを記入したデータを添付ファイルとして用意します。
最後にA社の担当者向けに用意したメールにA社向け添付ファイルをセットするという作業を100社分繰り返します。
手作業で考えると数時間かかる作業です。VBAなら30秒もかかりませんよ。
アウトプット
まずは動画(30秒程度)をご確認ください。以降の説明が理解しやすくなる為です。
出来上がったメールには会社名と担当者様宛の文字が用意されます。加えて添付ファイルにも取引先の名前が入ります。
![動画の補足説明(アウトプットの概要)](https://www.slt-pgming-21.net/wp-content/uploads/olk_adv_8-1024x643.png)
添付ファイルの中は以下画像の様になっています。取引先にかかわる品番などの情報が用意されています。
![動画の補足説明(添付ファイルの概要)](https://www.slt-pgming-21.net/wp-content/uploads/olk_adv_9-1024x534.png)
作業環境(フォルダやワークブック、シートなど)
作業環境を明確にしておきます。ExcelVBAでOutlookをコントロールします。(OutlookVBAは使いません)
続いて具体的に用意するもの(フォルダ、ファイルなど)を紹介しておきます。
- フォルダ(Outlook応用編)
- メール準備.xlsm
- 品番.xlsx
- 取引先.xlsx
- フォルダ(テンプレート)
- 調査票テンプレート.xlsx
- フォルダ(取引先ごとのファイル)
- 取引先ごとに用意することになる.xlsxファイル
- メールテンプレート.oft
- Outlook下書きフォルダ
作業の流れを画像にしてみました。⑩まで進むと1社分の作業が完了します。
その後は③~⑩の作業をループする事になります。100周すると全ての作業が完了するという流れです。
![作業環境を見た目で分かるように画像にしました](https://www.slt-pgming-21.net/wp-content/uploads/olk_adv_1-1024x538.png)
1_5_7 各種フォルダ
主にデータをまとめる為の役割をしています。
- 1_フォルダ(Outlook応用編)・・・データ全体を収納するフォルダです。
- 5_フォルダ(テンプレート)・・・テンプレートとして使用するデータを収納するフォルダです。
- 7_フォルダ(取引先ごとのファイル)・・・取引先ごとに用意する添付データを格納するためのフォルダです。
2_メール準備.xlsm
このエクセルファイルにマクロを用意しています。ワークシートにはマクロのトリガーとなるボタンを用意しています。
![メール準備.xlsmの中身](https://www.slt-pgming-21.net/wp-content/uploads/olk_adv_2.png)
3_品番.xlsx
取引先ごとに品番や品名の情報を格納しています。100社分計657件の情報を用意しました。
データはダミーデータを作るサイトで適当に作っています。
ワークシートは1枚です。ワークシート名は「品番」です。
![品番.xlsxの中身-1](https://www.slt-pgming-21.net/wp-content/uploads/olk_adv_3.png)
![品番.xlsxの中身-2](https://www.slt-pgming-21.net/wp-content/uploads/olk_adv_10.png)
4_取引先.xlsx
100社分の取引先コードや会社名、担当者、メールアドレスなどが格納されています。
こちらのデータもダミーデータを作るサイトで適当に作っています。
ワークシートは1枚です。ワークシート名は「取引先」です。
![取引先.xlsxの中身](https://www.slt-pgming-21.net/wp-content/uploads/olk_adv_4-1024x502.png)
6_調査票テンプレート.xlsx
品番.xlsxから情報を取り込む為のテンプレートです。
ワークシートは1枚です。ワークシート名は「調査依頼」です。
![調査票テンプレート.xlsxの中身](https://www.slt-pgming-21.net/wp-content/uploads/olk_adv_5-1024x604.png)
8_取引先ごとに用意することになる.xlsxファイル
調査票テンプレートを使って取引先.xlsxと品番.xlsxの情報をここで集結させます。
画像は有限会社オカモトさんの場合です。品番.xlsxから該当品番を含めた情報を取り出してセルに並べました。
ファイル名は「1000100_有限会社オカモト.xlsx」という名前が付けられます。その後⑧のフォルダに格納されます。
![最終的な添付ファイルの中身](https://www.slt-pgming-21.net/wp-content/uploads/olk_adv_6-1024x581.png)
9_メールテンプレート.oft
取引先ごとに用意するメールのテンプレートです。ここには取引先.xlsxからの情報を使ってメールを作ります。
最後に⑧のフォルダに入っているデータを添付させてOutlookの下書きフォルダに格納します。
![メールテンプレート.oftの中身](https://www.slt-pgming-21.net/wp-content/uploads/olk_adv_7.png)
10_Outlook下書きフォルダ
取引先ごとに用意された添付ファイル付きのメールを格納しておく場所です。
メール作成後に送信してしまうとミスがあった時に取り返しのつかない事になります。
まずは一時置き場に格納し抜き取り検査などを行い問題無い事を確認してからメールを送る様にしています。
(今回はメールを自動送信するコードは用意していません)
コード
コードはこちらです。コードの量が多いのでウインドウを2つに分けました。
- 添付データを作成してメールに添付 ・・・ メインプロシージャです
- datasetting ・・・ 取引先.xlsxと品番.xlsxからデータを取得します
- r ・・・ 最終行を取得する為の関数
- c ・・・ 最終列を取得する為の関数
'****************************************************************
Sub 添付データを作成してメールに添付()
Dim sup As Variant 'supplier
Dim num As Variant 'number
Dim frow As Long 'finalrow
Dim fclm As Long 'finalcolumn
Dim wb1 As Workbook '取引先
Dim wb2 As Workbook '品番
Application.ScreenUpdating = False
Call datasetting(sup, num, frow, fclm, wb1, wb2)
Call datapreparation(sup, num, fclm)
Application.ScreenUpdating = True
MsgBox "作業完了"
End Sub
'****************************************************************
Sub datasetting(ByRef sp As Variant, ByRef nm As Variant, ByVal frw As Long, ByVal fcm As Long, ByVal w1 As Workbook, ByVal w2 As Workbook)
'必要なデータを揃える
Set w1 = Workbooks.Open(ThisWorkbook.Path & "\取引先.xlsx")
frw = r(w1.Sheets("取引先"), 1)
fcm = c(w1.Sheets("取引先"), 1)
With w1.Sheets("取引先")
sp = .Range(.Cells(1, 1), .Cells(frw, fcm))
End With
w1.Close
Set w2 = Workbooks.Open(ThisWorkbook.Path & "\品番.xlsx")
frw = r(w2.Sheets("品番"), 1)
fcm = c(w2.Sheets("品番"), 1)
With w2.Sheets("品番")
nm = .Range(.Cells(1, 1), .Cells(frw, fcm))
End With
w2.Close
End Sub
'****************************************************************
Function r(sht, rw)
'最終行を取得する為の関数
r = sht.Cells(Rows.Count, rw).End(xlUp).row
End Function
'****************************************************************
Function c(sht, cm)
'最終列を取得する為の関数
c = sht.Cells(cm, Columns.Count).End(xlToLeft).Column
End Function
'****************************************************************
続いて残り2つのプロシージャです。
- datapreparation ・・・ 取引先ごとに調査票.xlsxを作ります
- attachedfile ・・・ メールのテンプレートに取引先の情報と添付ファイルを用意します
'****************************************************************
Sub datapreparation(ByRef sp As Variant, ByRef nm As Variant, ByVal frw As Long)
'仕入先&品番データを使って調査票を作る
Dim sch1 As Long 'serch1
Dim sch2 As Long 'serch2
Dim pth As String 'filepath ファイルパス
Dim fname As String 'filename ファイルネーム
Dim wb3 As Workbook '調査票
Dim cpy As String 'company 会社名
Dim name As String 'name 担当者名
Dim ead As String 'emailaddress メルアド
Workbooks.Open (ThisWorkbook.Path & "\テンプレート\調査票テンプレート.xlsx")
Set wb3 = Workbooks("調査票テンプレート.xlsx")
ReDim tem(1 To 4, 1 To 1) As Variant 'temporary
Dim snum As Long: snum = 1 'serialnumber
For sch1 = LBound(sp) + 1 To UBound(sp)
For sch2 = LBound(nm) + 1 To UBound(nm)
If sp(sch1, 1) = nm(sch2, 3) Then
tem(1, snum) = nm(sch2, 1)
tem(2, snum) = nm(sch2, 2)
tem(3, snum) = nm(sch2, 3)
tem(4, snum) = nm(sch2, 4)
snum = snum + 1
ReDim Preserve tem(1 To 4, 1 To snum)
End If
Next
ReDim Preserve tem(1 To 4, 1 To snum - 1)
With wb3.Sheets("調査依頼")
.Range(.Cells(6, 2), .Cells(UBound(tem, 2) + 5, 5)) = WorksheetFunction.Transpose(tem)
'最終行を認識(罫線を書く為)
frw = r(wb3.Sheets("調査依頼"), 2)
'必要箇所にまずは黒の罫線を一通り書く
With .Range(.Cells(6, 2), .Cells(frw, 5))
.Borders.LineStyle = xlContinuous
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Columns("A:E").AutoFit
pth = ThisWorkbook.Path & "\取引先ごとのファイル"
fname = "\" & sp(sch1, 3)
wb3.SaveCopyAs Filename:=ThisWorkbook.Path & "\取引先ごとのファイル" & fname
.Range(.Cells(6, 2), .Cells(UBound(tem, 2) + 5, 5)).Clear
End With
snum = 1
ReDim tem(1 To 4, 1 To snum)
cpy = sp(sch1, 2)
name = sp(sch1, 4)
ead = sp(sch1, 5)
Call attachedfile(fname, cpy, name, ead)
Next
Application.DisplayAlerts = False
wb3.Close
Application.DisplayAlerts = True
End Sub
'****************************************************************
Sub attachedfile(ByVal fnm As String, ByVal cy As String, ByVal nm As String, ByVal ea As String)
'datapreparationで作ったデータをメールに添付してOutlookの下書きに格納する
Dim Olk As Outlook.Application
Dim Mail As Mailitem
Dim Amt As Attachments
Dim a As String
Dim b As String
Dim c As String
Set Olk = CreateObject("Outlook.Application")
Set Mail = Olk.CreateItemFromTemplate(ThisWorkbook.Path & "\テンプレート\メールテンプレート.oft")
Set Amt = Mail.Attachments
With Mail
.To = ea 'メール宛先
.Subject = "ご確認ください" 'メール件名
.BodyFormat = 2 'メールの形式
a = .HTMLBody 'テンプレートの内容を格納
b = "<span style=""font-size:11pt"";""font-family:游ゴシック"">" '書式設定
c = cy & " " & nm & "様"
'a、b、cを合わせる
.HTMLBody = b & c & a
End With
Amt.Add ThisWorkbook.Path & "\取引先ごとのファイル" & fnm
Mail.Save
End Sub
'****************************************************************
解説
SubプロシージャとFunctionプロシージャ合わせて6つあります。プロシージャごとに解説します。
添付データを作成してメールに添付
このプロシージャがワークシートのボタンと連動しています。
必要な変数を用意したり各プロシージャを呼び出す為の役割をしています。
ポイントはサブルーチンですね。Callメソッドを使って別のプロシージャを呼び出しています。
関連記事【マトリクスで理解する】プロシージャを分割したマクロを用意する方法
datasetting
取引先.xlsxと品番.xlsxから情報を取り出して配列に格納しています。
各データの最終行と最終列はFunctionプロシージャで値を用意することにしています。
関連記事【応用編】ExcelVBAでピボットテーブルと連動したグラフを自動で作成する
r
最終行を返す関数として用意しています。
c
最終列を返す関数として用意しています。
datapreparation
各種データを使って取引先ごとに用意する調査票(.xlsxデータ)を作り込んでいます。
datasettingプロシージャで取り込んだ値を使って調査票テンプレートに値を用意していきます。
ここでのポイントは2次元配列とファイルパスです。
関連記事【検索にも使える】VBAの2次元配列で作業の高速化を実現させる
2次元配列は動的2次元配列を使っています。動的配列については解説記事がありません。事用意出来次第掲載します。
配列はローカルウインドウを見ながら1行ずつコードを実行していく事である程度理解することができます。
どうしても分からない方は問い合わせフォームより連絡をお願いします。
ファイルパスはThisWorkbookオブジェクトのPathプロパティを使うとうまくコードを書くことができます。
関連記事【VBA】絶対パス相対パスの書き方|理解はカレントディレクトリがポイント
attachedfile
datapreparationの中から呼び出されるプロシージャです。
主にOutlookに対する操作を行うプロシージャです。前回記事の内容が多く含まれています。
このプロシージャを理解するには前回記事を見ていただくことをおすすめします。
関連記事エクセルVBA×Outlook|メールにハイパーリンク&添付ファイルを用意する
お知らせ参照設定だけは忘れないようにしてください
VBEの参照設定からMicrosoft Outlook 16.0 Object Libraryを選択してからコードを実行してください。
まとめ
複数の宛先毎に添付ファイル付きメールを作成するという作業をExcelVBAで自動化してみました。
今回は100社分のデータを用意して作業してみました。これだけでも手作業でやると思えばかなり作業が楽になります。
参考:実務で使う際はもう少し工夫が必要です
この事例を実務に当てはめて使うとなると取引先から100個のデータが返ってくる事になります。
100個の.xlsxが返ってくるとなるとまた集計などで時間がかかることが予想されます。
そんな時は調査票にチェックを付けてもらうような仕様にしておくことをおすすめします。
返却されてきたデータは別のVBAで集計をかけることで作業時間短縮を見込めるからです。