VBAでOutlook操作・下書きメールにファイルを添付する方法を紹介しています！
前回の記事では、「指定のキーワードに合致したファイル」を、下書きメールに添付するマクロを紹介しました。
【VBAでOutlook操作】複数ファイルを添付できる！下書きメールを一括作成するマクロExcelシートのデータを元に、Outlookの下書きメールを一括作成するマクロです。キーワードに一致する複数ファイルをまとめて添付できるのがポイントです
...
指定のキーワードに合致するファイルが存在するか否かに関わらず、Excelシートに存在するデータの件数分、下書きアイテムを作成するマクロでした。
もり
この記事で紹介するのは、「添付ファイルが存在しない場合はメールを作らないマクロ」だよ
Excelシートのデータを元に、
- 下書きメールを作成する
- 指定のキーワードに一致するファイルを添付する（複数ファイルを添付可能）
※ただし、キーワードに一致するファイルが存在しない場合は、下書きメール自体を作成しない
具体例をみてみましょう。
メールの元ネタになるExcelシートに、５件のデータがあります。F列に指定したキーワードに一致するファイルを下書きメールに添付します。
ファイルを格納しているフォルダの中身には、佐藤・高橋・田中の３人分のファイルしか存在しません。このような場合に、鈴木・伊藤さん宛ての下書きメールは作成しません。
つまり、「キーワードに一致するファイルが見つからない場合は、下書きメールを作成しない」がこの記事のお題です。
↓マクロ実行結果
このように、添付ファイルが存在する場合のみ、下書きメールを作成します。
※以降の説明は、前回記事のコードを元にしています。
スポンサーリンク
添付ファイルが存在するか否かの判定をする
SubプロシージャFileAttachでファイルを検索して添付するから、このプロシージャの中で判定すればいいのかな？
もり
そうだね！1つでもファイルを添付したらTrueを返す（0ならFalseを返す）という処理を加えてみよう
添付したファイル数をカウントして、プロシージャの最後でファイル数をチェックして、True/Falseを返せば良さそうだね
あれ？Subプロシージャって値を返せるんだっけ？
あれ？Subプロシージャって値を返せるんだっけ？
もり
おっ、よく気づいたね～！
Subプロシージャは値を返さないから、FileAttachをFunctionプロシージャに変更するよ！
Subプロシージャは値を返さないから、FileAttachをFunctionプロシージャに変更するよ！
変数fileCntを用意して、添付したファイル数をカウントし、その数値によって返り値を決めます。
- 1以上の場合 = True
- それ以外(=0) = False
※Boolean型の初期値はFalseなので、返り値を指定しなければFalseが返ります。この性質を利用して、fileCntが1以上の場合のみ、返り値Trueを指定します。
以下コードのコメントで★をつけた行がポイントです
|
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 |
' 処理① キーワードに合致するファイルを添付する ' 処理② 1つ以上のファイルが見つかった場合、Trueを返す Function FileAttach(attachObj As Object, keyword As String) As Boolean Dim fileCnt As Long '★添付したファイル数をカウントする Dim FileStorePath As String 'ファイル格納パス FileStorePath = "C:\Outlookテスト\file" Dim FileName As String FileName = Dir(FileStorePath & "\" & "*") 'フォルダ内のファイル数、検索を繰り返す&" Do While FileName <> "" 'キーワードを含むファイルが見つかったら、下書きアイテムに添付する If InStr(FileName, keyword) > 0 Then attachObj.Add FileStorePath & "\" & FileName fileCnt = fileCnt + 1 '★添付したファイル数 End If FileName = Dir() Loop Set attachObj = Nothing '★1以上のファイルを添付した場合Trueを返す '（Boolean型の初期値はFalse） If fileCnt > 0 Then FileAttach = True End Function |
添付ファイルが存在する場合のみメールアイテムを作成する
続いてメイン処理です
もり
ポイントは31行目！FileAttachの返り値をチェックするよ
If文を使用して、FunctionプロシージャFileAttachの返り値がTrueの場合のみ、下書きメールを作成します。
FileAttachの返り値がFalse（添付ファイルがゼロ）の場合、メールアイテムを作成しません。
|
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 |
Enum col '1以降の数値を省略した場合は+1される 宛先 = 1 複写 氏名 使用日 金額 添付キーワード End Enum Sub main() 'Outlookオブジェクトの作成 Dim OutlookObj As Outlook.Application Set OutlookObj = New Outlook.Application Dim r As Long For r = 2 To Cells(1, 1).End(xlDown).Row 'メールアイテムオブジェクト作成 Dim mailItemObj As Outlook.MailItem Set mailItemObj = OutlookObj.CreateItem(olMailItem) '添付ファイルオブジェクトの生成 Dim attachObj As Outlook.Attachments Set attachObj = mailItemObj.Attachments Dim keyword As String keyword = Cells(r, col.添付キーワード) '★添付ファイルが存在する場合のみ、メールアイテムを作成する If FileAttach(attachObj, keyword) = True Then 'メール本文作成 Dim mailBody As String mailBody = CreateMailBody(r) 'メールアイテム作成 With mailItemObj .To = Cells(r, col.宛先).Value .CC = Cells(r, col.複写).Value .Subject = Cells(1, "J").Value '件名 .Body = mailBody '本文 End With mailItemObj.Display '下書きを表示 '次のメールアイテムを作成するためいったん破棄 Set mailItemObj = Nothing End If Next r End Sub |
へぇ～これで添付ファイルがある場合だけ、メールを作るんだね
コードまとめ
FunctionプロシージャCreateMailBodyは前回記事から変更なしです。
|
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 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 |
Enum col '1以降の数値を省略した場合は+1される 宛先 = 1 複写 氏名 使用日 金額 添付キーワード End Enum Sub main() 'Outlookオブジェクトの作成 Dim OutlookObj As Outlook.Application Set OutlookObj = New Outlook.Application Dim r As Long For r = 2 To Cells(1, 1).End(xlDown).Row 'メールアイテムオブジェクト作成 Dim mailItemObj As Outlook.MailItem Set mailItemObj = OutlookObj.CreateItem(olMailItem) '添付ファイルオブジェクトの生成 Dim attachObj As Outlook.Attachments Set attachObj = mailItemObj.Attachments Dim keyword As String keyword = Cells(r, col.添付キーワード) '★添付ファイルが存在する場合のみ、メールアイテムを作成する If FileAttach(attachObj, keyword) = True Then 'メール本文作成 Dim mailBody As String mailBody = CreateMailBody(r) 'メールアイテム作成 With mailItemObj .To = Cells(r, col.宛先).Value .CC = Cells(r, col.複写).Value .Subject = Cells(1, "J").Value '件名 .Body = mailBody '本文 End With mailItemObj.Display '下書きを表示 '次のメールアイテムを作成するためいったん破棄 Set mailItemObj = Nothing End If Next r End Sub ' 【機能】Excelシート上の指定行番号のメール本文を作成する Function CreateMailBody(r As Long) As String Dim sName As String, DayOfUse As String, price As Long sName = Cells(r, col.氏名).Value DayOfUse = Cells(r, col.使用日).Value price = Cells(r, col.金額).Value Dim sign As String '署名 sign = Cells(12, "J").Value Dim mBody As String 'メール本文 mBody = Cells(2, "J").Value '初期値を設定 mBody = Replace(mBody, "（氏名）", sName) mBody = Replace(mBody, "（使用日）", DayOfUse) mBody = Replace(mBody, "（金額）", price) mBody = mBody & vbCrLf & vbCrLf & sign '末尾に署名を付与 CreateMailBody = mBody End Function ' 処理① キーワードに合致するファイルを添付する ' 処理② 1つ以上のファイルが見つかった場合、Trueを返す Function FileAttach(attachObj As Object, keyword As String) As Boolean Dim fileCnt As Long '★添付したファイル数をカウントする Dim FileStorePath As String 'ファイル格納パス FileStorePath = "C:\Outlookテスト\file" Dim FileName As String FileName = Dir(FileStorePath & "\" & "*") 'フォルダ内のファイル数、検索を繰り返す&" Do While FileName <> "" 'キーワードを含むファイルが見つかったら、下書きアイテムに添付する If InStr(FileName, keyword) > 0 Then attachObj.Add FileStorePath & "\" & FileName fileCnt = fileCnt + 1 '★添付したファイル数 End If FileName = Dir() Loop Set attachObj = Nothing '★1以上のファイルを添付した場合Trueを返す '（Boolean型の初期値はFalse） If fileCnt > 0 Then FileAttach = True End Function |
ポイントまとめ
ループ処理を何回通過したか？をチェックするには、カウント変数を用意すると便利です。
- カウント変数を用意する（ループの前で宣言）
- ループを通過するたびにカウントを＋１する
- プロシージャの最後に、カウント変数の値をチェックする
→カウント変数の値に応じて、返り値を決める
ポイントはFunctionプロシージャだね
もり
そうだね！Functionプロシージャってなに？って人向けに、この記事で詳しく解説してるよ～
【ExcelVBA】Functionプロシージャとは？（図解付き）引数とは？値を渡す？結果を返す？
VBA入門者が苦戦するFunctionプロシージャを徹底解説しています！...
連載目次：VBAでOutlook操作
Excelシートのデータから下書きメールを一括作成する方法、指定のキーワードに合致するファイルを添付する方法などを紹介しています。
スポンサーリンク
スポンサーリンク
