Excel VBA メール送信ツール(Outlook)

VBAでOutlookのメール送信について紹介します。

自動でOutlookのメール送信するツールを作ってみました。

実際に作ったファイルはこちらから無料でダウンロードできます。

Table of Contents

メール(Outlook)用の参照設定

ファイル用もフォルダ用もダイアログを開くに参照設定を必要です。

手順はコードエディターから「ツール(T)」→「参照設定(R)」と移動します。

その後、Microsoft Outlook 16.0 Object Libraryにチェックを付けておいてください。

16.0はバージョンに寄ります。

メール(Outlook)送信処理のコード

処理の流れは以下の順です。

①メール情報(件名、宛先など)を取得
②メールに情報をセットする
③添付ファイルを貼り付ける
④メールを送信する
⑤次のエクセルシートの情報を読取って①から～④を繰り返す

コード

'==============================
'目的　　　 ：シート分のメールを送信する
'==============================
Sub SendMail_Click()
　　
　　Dim MyDir As String　　　　　　　　　　　　　　　　　'自分のファイルが存在するディレクトリ格納用
　　Dim i As Long　　　　　　　　　　　　　　　　　　　　　'ループ用変数
　　Dim j As Long　　　　　　　　　　　　　　　　　　　　　'ループ用変数
　　Dim SheetCnt As Long　　　　　　　　　　　　　　　　　'シート数を格納する変数
　　Dim SheetName As String　　　　　　　　　　　　　　　'シート名を格納する変数
　　
　　Dim ToAddress As String　　　　　　　　　　　　　　　'Toアドレス用の変数
　　Dim CcAddress As String　　　　　　　　　　　　　　　'Ccアドレス用の変数
　　Dim BccAddress As String　　　　　　　　　　　　　　'Bccアドレス用の変数
　　Dim Subject As String　　　　　　　　　　　　　　　　'件名用の変数
　　Dim MailBody As String　　　　　　　　　　　　　　　'メール本文用の変数
　　Dim Signature As String　　　　　　　　　　　　　　'署名用の変数
　　Dim OutlookObj As Outlook.Application　　　　　　'Outlookで使用するオブジェクト生成
　　Dim MailItemObj As Outlook.MailItem　　　　　　　'Outlookで使用するオブジェクト生成
　　Dim Attachments As Outlook.Attachments　　　　 'Outlookで使用するオブジェクト生成
　　Dim AttachmentPath As String　　　　　　　　　　　'添付ファイルの格納用変数
　　Dim AttachmentsPath() As String　　　　　　　　　'添付ファイルの格納配列
　　
　　
　　'自分の配置されているパスを取得
　　MyDir = ThisWorkbook.Path
　　
　　'シート件数を取得
　　SheetCnt = ThisWorkbook.Sheets.Count
　　'-------シート枚数分ループ(2枚目のシートから)-------
　　For i = 2 To SheetCnt
　　
　　　　'シート名を取得
　　　　SheetName = Sheets(i).Name
　　　　'-------メール情報を取得-------
　　　　ToAddress = Sheets(i).Range("Mail_TO").Value　　　　　　　　　'To宛先
　　　　CcAddress = Sheets(i).Range("Mail_CC").Value　　　　　　　　　'cc宛先
　　　　BccAddress = Sheets(i).Range("Mail_BCC").Value　　　　　　　　'bcc宛先
　　　　Subject = "【" & SheetName & "様】" & _
　　　　　　　　　　　　Sheets(i).Range("Mail_Subject").Value　　　　　'件名
　　　　MailBody = Sheets(i).Range("Mail_Body").Value　　　　　　　　'メール本文
　　　　Signature = Sheets(i).Range("Mail_Signature").Value　　　　 '署名
　　
　　　　'-------メールに情報をセットする-------
　　　　Set OutlookObj = CreateObject("Outlook.Application")
　　　　Set MailItemObj = OutlookObj.CreateItem(olMailItem)
　　　　MailItemObj.BodyFormat = 2　　　　　　　　　　　　　　　　　　　　　　　'HTML形式に変更
　　　　MailItemObj.To = ToAddress　　　　　　　　　　　　　　　　　　　　　　　'to宛先をセット
　　　　MailItemObj.CC = CcAddress　　　　　　　　　　　　　　　　　　　　　　　'cc宛先をセット
　　　　MailItemObj.BCC = BccAddress　　　　　　　　　　　　　　　　　　　　　　'bcc宛先をセット
　　　　MailItemObj.Subject = Subject　　　　　　　　　　　　　　　　　　　　　 '件名をセット
　　　　MailItemObj.Body = MailBody & vbCrLf & vbCrLf & Signature　　　 '本文+署名
　　　　
　　　　'-------添付ファイルを貼り付ける-------'
　　　　'オブジェクト生成
　　　　Set Attachments = MailItemObj.Attachments
　　　　
　　　　'[yyyymmdd_会社名].[拡張子]を検索し、取得する'
　　　　AttachmentsPath() = FileSearch(Format(Now(), "yyyymmdd") & "_" & SheetName & ".*", MyDir & "\添付ファイル\")　'"
　　　　
If AttachmentsPath(0) = "dummy" Then
'添付ファイルが一件もなければ、次のメール処理へ行く(発注連絡が不要なため)
GoTo nextDO
Else
'添付ファイルが一件でもあれば添付
'ファイル件数分ループして添付する
For j = 0 To UBound(AttachmentsPath())
'ファイルパスを取得
AttachmentPath = AttachmentsPath(j)
'ファイルを添付
Attachments.Add AttachmentPath
Next j
End If
　　
　　　　'-------メールを送信する-------
　　　　MailItemObj.Send
　　
　　　　'-------Outlookを閉じる(オブジェクトを解放)---
　　　　Set OutlookObj = Nothing
　　　　Set MailItemObj = Nothing
　　　　
nextDO:
　　Next i
　　
　　MsgBox "送信が完了しました。"
　　
End Sub

'==============================

'目的　　　：シート分のメールを送信する

'==============================

Sub SendMail_Click()

　　Dim MyDir As String　　　　　　　　　　　　　　　　　'自分のファイルが存在するディレクトリ格納用

　　Dim i As Long　　　　　　　　　　　　　　　　　　　　　'ループ用変数

　　Dim j As Long　　　　　　　　　　　　　　　　　　　　　'ループ用変数

　　Dim SheetCnt As Long　　　　　　　　　　　　　　　　　'シート数を格納する変数

　　Dim SheetName As String　　　　　　　　　　　　　　　'シート名を格納する変数

　　Dim ToAddress As String　　　　　　　　　　　　　　　'Toアドレス用の変数

　　Dim CcAddress As String　　　　　　　　　　　　　　　'Ccアドレス用の変数

　　Dim BccAddress As String　　　　　　　　　　　　　　'Bccアドレス用の変数

　　Dim Subject As String　　　　　　　　　　　　　　　　'件名用の変数

　　Dim MailBody As String　　　　　　　　　　　　　　　'メール本文用の変数

　　Dim Signature As String　　　　　　　　　　　　　　'署名用の変数

　　Dim OutlookObj As Outlook.Application　　　　　　'Outlookで使用するオブジェクト生成

　　Dim MailItemObj As Outlook.MailItem　　　　　　　'Outlookで使用するオブジェクト生成

　　Dim Attachments As Outlook.Attachments　　　　 'Outlookで使用するオブジェクト生成

　　Dim AttachmentPath As String　　　　　　　　　　　'添付ファイルの格納用変数

　　Dim AttachmentsPath() As String　　　　　　　　　'添付ファイルの格納配列

　　'自分の配置されているパスを取得

　　MyDir = ThisWorkbook.Path

　　'シート件数を取得

　　SheetCnt = ThisWorkbook.Sheets.Count

　　'-------シート枚数分ループ(2枚目のシートから)-------

　　For i = 2 To SheetCnt

　　　　'シート名を取得

　　　　SheetName = Sheets(i).Name

　　　　'-------メール情報を取得-------

　　　　ToAddress = Sheets(i).Range("Mail_TO").Value　　　　　　　　　'To宛先

　　　　CcAddress = Sheets(i).Range("Mail_CC").Value　　　　　　　　　'cc宛先

　　　　BccAddress = Sheets(i).Range("Mail_BCC").Value　　　　　　　　'bcc宛先

　　　　Subject = "【" & SheetName & "様】" & _

　　　　　　　　　　　　Sheets(i).Range("Mail_Subject").Value　　　　　'件名

　　　　MailBody = Sheets(i).Range("Mail_Body").Value　　　　　　　　'メール本文

　　　　Signature = Sheets(i).Range("Mail_Signature").Value　　　　 '署名

　　　　'-------メールに情報をセットする-------

　　　　Set OutlookObj = CreateObject("Outlook.Application")

　　　　Set MailItemObj = OutlookObj.CreateItem(olMailItem)

　　　　MailItemObj.BodyFormat = 2　　　　　　　　　　　　　　　　　　　　　　　'HTML形式に変更

　　　　MailItemObj.To = ToAddress　　　　　　　　　　　　　　　　　　　　　　　'to宛先をセット

　　　　MailItemObj.CC = CcAddress　　　　　　　　　　　　　　　　　　　　　　　'cc宛先をセット

　　　　MailItemObj.BCC = BccAddress　　　　　　　　　　　　　　　　　　　　　　'bcc宛先をセット

　　　　MailItemObj.Subject = Subject　　　　　　　　　　　　　　　　　　　　　 '件名をセット

　　　　MailItemObj.Body = MailBody & vbCrLf & vbCrLf & Signature　　　 '本文+署名

　　　　'-------添付ファイルを貼り付ける-------'

　　　　'オブジェクト生成

　　　　Set Attachments = MailItemObj.Attachments

　　　　'[yyyymmdd_会社名].[拡張子]を検索し、取得する'

　　　　AttachmentsPath() = FileSearch(Format(Now(), "yyyymmdd") & "_" & SheetName & ".*", MyDir & "\添付ファイル\")　'"

If AttachmentsPath(0) = "dummy" Then

'添付ファイルが一件もなければ、次のメール処理へ行く(発注連絡が不要なため)

GoTo nextDO

Else

'添付ファイルが一件でもあれば添付

'ファイル件数分ループして添付する

For j = 0 To UBound(AttachmentsPath())

'ファイルパスを取得

AttachmentPath = AttachmentsPath(j)

'ファイルを添付

Attachments.Add AttachmentPath

Next j

End If

　　　　'-------メールを送信する-------

　　　　MailItemObj.Send

　　　　'-------Outlookを閉じる(オブジェクトを解放)---

　　　　Set OutlookObj = Nothing

　　　　Set MailItemObj = Nothing

nextDO:

　　Next i

　　MsgBox "送信が完了しました。"

End Sub

解説

メール情報を取得

重要なポイントは名前の定義をしていることです。

宛先Toであれば「Mail_TO」のようにすべてのシートに設定がしてあります。

各シートに全て同じ名前を付けることで同じ処理をシートごとに繰り返せるようにしています。

そして各シートの値は変数に格納していく処理になっています。

※シートをコピーして増やしても名前の定義は引き継がれるため処理に問題はありません。

メールに情報をセットする

Outlookのオブジェクトを生成していま。

その後、それぞれToや本文の情報をOutlookのオブジェクトにセットしていっています。

添付ファイルを貼り付ける

まず添付ファイルのオブジェクト生成しています。

FileSearchメソッドを使って、添付ファイルのパスを取得しメールのオブジェクトに張り付ける処理を行っています。

FileSearchは後で説明を記載しています。

その後、添付ファイルがない場合、メールは送らず次のシートを処理するようになっています。

※発注連絡という想定なので、発注書の添付ファイルがなければ連絡はする必要がないから送らないという考え方です。

メールを送信する・Outlookを閉じる

最後にメールを送信します。

その後、作成したオブジェクトは破棄して次のメール作成・送信処理へ行きます。

メール添付ファイル取得 FileSearchメソッド

送信対象のファイル([yyyymmdd_シート名.拡張子]フォーマット)のファイル名を検索し配列に格納する処理です。

検索する場所は「..\VBA Outlookメール送信\添付ファイル」以下のみです。

他の場所に配置したファイルは添付ファイルとして検索されません。

コード

'==============================
'目的　　　 ：添付ファイルを検索し、ファイルのパスを取得する
'引数　　　 ：SearchText　　　　　　　　　検索するファイル名
'　　　　　　：SearchPath　　　　　　　　 検索するパス
'戻り値　　　: ファイルパスの配列
'==============================
Private Function FileSearch(SearchText As String, SearchPath As String) As String()
Dim FileName As String
Dim Cnt As Long
Dim Files() As String                         'ファイルパス格納用配列
'中身をダミー値でセット
ReDim Files(0)
Files(0) = "dummy"
'ファイルを検索
FileName = Dir(SearchPath & "\" & SearchText)
Do While FileName <> ""
'ファイル名を返却用配列に格納
ReDim Preserve Files(Cnt) As String
Files(Cnt) = SearchPath & FileName
Cnt = Cnt + 1
' 次のファイル名を参照
FileName = Dir()
Loop
　　FileSearch = Files()
　　
End Function

'==============================

'目的　　　：添付ファイルを検索し、ファイルのパスを取得する

'引数　　　：SearchText　　　　　　　　　検索するファイル名

'　　　　　　：SearchPath　　　　　　　　検索するパス

'戻り値　　　: ファイルパスの配列

'==============================

Private Function FileSearch(SearchText As String, SearchPath As String) As String()

Dim FileName As String

Dim Cnt As Long

Dim Files() As String 'ファイルパス格納用配列

'中身をダミー値でセット

ReDim Files(0)

Files(0) = "dummy"

'ファイルを検索

FileName = Dir(SearchPath & "\" & SearchText)

Do While FileName <> ""

'ファイル名を返却用配列に格納

ReDim Preserve Files(Cnt) As String

Files(Cnt) = SearchPath & FileName

Cnt = Cnt + 1

' 次のファイル名を参照

FileName = Dir()

Loop

　　FileSearch = Files()

End Function

解説

引数として受け取った検索フォルダ(SearchPath)を検索条件(SearchText)を元に検索します。

見つかったファイルのパスを配列に格納していきます。

検索条件に一致するファイルが見つからなくなったら配列を呼び出し元に返しています。

送信結果

送信結果はこんなメールです。

メール送信と言いつつガチガチに業務を想定したツールになってしまっています…

使えそうなところをアレンジしていってみてください。

プログラミング初心者の独学方法文系卒の経験談私はIT系の会社に勤めて4年目ですが、最初の1年は開発をさせてもらえませんでした。文系卒でプログラミング経験はなかったの...

プログラミングの独学とはエラーとの闘いプログラミングを勉強し始めた初心者の方はつまづくことが多いと思います。私も最初はエラーが出るたびにいちいちビビッて、意味...

・【エクセルVBA】Outlookでメールを作成・送信する方法
https://tonari-it.com/excel-vba-outlook-mail-send/
・VBAでメールを自動送信！エクセルマクロでoutlook操作する方法
http://www.fastclassinfo.com/entry/vba_outlook_sendmail
・シートを指定してRangeを取得する
https://www.relief.jp/docs/excel-vba-get-range-specific-sheet.html
・PDF発注書テンプレート
https://pdf.wondershare.jp/templates/purchase-order-template.html
・FileSystemObjectオブジェクト – FileExistsメソッド
http://officetanaka.net/excel/vba/filesystemobject/filesystemobject10.htm
・ファイルの一覧を取得する
http://officetanaka.net/excel/vba/file/file07.htm

Excel VBA メール送信ツール(フリーメール)VBAでメール送信について紹介します。自動でメール送信するツールを作ってみました。今回はOutlookではなくフリーメー...

Excel VBA

メール(Outlook)用の参照設定

メール(Outlook)送信処理のコード

コード