Excelで作成したメールアドレス一覧を使ってOutlookで一斉送信する

2022年2月20日

同じ内容のメールを複数の宛先に送信する場合、通常は一件ずつメールを作成して送信することになりますがExcelVBAを使うと１クリックで複数の宛先に一斉メールを送ることができます。また、一斉にメールを送る際に複数のメールアドレスを設定して送ると迷惑メールとして判断されることがありますが、ExcelVBAを使った送信ではその心配がありません。今回はExcelVBAを使ったメール送信アプリをご紹介します。メールに関連したルーティンワークで効率化が図れると思いますので参考にしてください。

サンプルアプリ実行結果

下記赤枠の「メール送信」ボタンをクリックすると、メールアドレス欄にあるアドレス宛に上から順番に１件ずつメールが送信されます。その際、件名に件名欄の内容が本文に本文欄にある内容がセットされメールが送られます。また、以下のコードを追加することにより添付ファイルを貼り付けることができます。
「UrlToLocal」はカレントフォルダ（当サンプルファイルが置かれているフォルダ）のパスを求める関数です。詳しくは下記リンク先をご覧ください。
https://scodebank.com/?p=696

'添付ファイルがあるパス
attachmentPath = UrlToLocal(ThisWorkbook.Path) & "\テストメール.txt"

'上記パスにあるファイルを添付
Call objMail.Attachments.Add(attachmentPath)

上の画像のようにメールアドレスをあらかじめリスト化しておくことにより、ボタンを１クリックするだけで一斉にメールを送ることが可能になります。

ExcelVBAでOutlookを操作するための準備

Outlookを操作するため参照設定の追加が必要になります。手順は以下の通りです。

・「ツール」から「参照設定」を選択します。


・一覧の中で「Microsoft Outlook ○○.〇 Object Library」にチェックを入れてOKボタンをクリックします。

サンプルコードの処理内容

次はExcelVBAでOutlookを操作するコードの説明です。

まず、下記のように「Outlook.Application」を指定して変数を定義します。
　　Dim objOutlook As Outlook.Application
上で定義した変数にOutlook.Applicationを設定します。
　　 Set objOutlook = New Outlook.Application

次にメール送信用の変数を設定します。
　　Dim objMail As Outlook.MailItem
上で定義した変数にobjOutlook.CreateItem(olMailItem)を設定します。
　　Set objMail = objOutlook.CreateItem(olMailItem)

objMailオブジェクトのプロパティを使って宛先、メール件名、メール本文を設定します。
　　objMail.To = .Range(Cells(i, 3).Address).Value　　　　　’メール宛先
　　objMail.Subject = .Range(Cells(11, 3).Address).Value　 'メール件名
　　objMail.BodyFormat = olFormatPlain　　　　　　　　　 'メールの形式
　　objMail.Body = .Range(Cells(12, 3).Address).Value　　 'メール本文

BodyFormatで指定できるメールの形式は下記の通りです。
・プレーンテキスト　：olFormatPlain
・HTML　　　　　　：olFormatHTML
・リッチテキスト　　：olFormatRichText

最後にメールを送信します
　　objMail.Send

送ったメールはOutlookの送信済アイテムで確認することができます。

MailItemオブジェクトのプロパティとメソッドは他にも色々用意されていますので、必要に応じて以下のサイトを参照ください。
　MailItemオブジェクトのプロパティとメソッド

サンプルコード 　 コードの作成手順はこちら 

Option Explicit '変数の宣言を強制する

Sub OpenOutlookApp()

 Dim objOutlook As Outlook.Application '「Outlook.Application」変数定義
 Dim objMail As Outlook.MailItem       '「Outlook.MailItem」変数定義
 Dim attachmentPath As String          '添付ファイルのパスを格納する変数を定義
 Dim wsMail As Worksheet               'ワークシート名を格納する変数を定義
 Dim i As Integer                      'ループカウンタの変数を定義

 Set objOutlook = New Outlook.Application '変数にOutlook.Applicationオブジェクトを設定

'メールアドレスの数分ループさせる(４行目～８行目)
 For i = 4 To 8 Step 1

  Set wsMail = ThisWorkbook.Sheets("Sheet1")
  Set objMail = objOutlook.CreateItem(olMailItem) '変数にobjOutlook.CreateItem(olMailItem)オブジェクトを設定

  With wsMail

    objMail.To = .Range(Cells(i, 3).Address).Value         'メールの宛先にアドレスを設定
    objMail.Subject = .Range(Cells(11, 3).Address).Value   'メールの件名を設定
    objMail.BodyFormat = olFormatPlain                     'メールの形式を設定
    objMail.Body = .Range(Cells(12, 3).Address).Value      'メールの本文を設定

   '当Excelファイルのフォルダにある添付ファイルのパスを設定
    attachmentPath = UrlToLocal(ThisWorkbook.Path) & "\テストメール.txt"
   'メールにファイルを添付
    Call objMail.Attachments.Add(attachmentPath)

    objMail.Send  'メールを送信
    
  End With

 Next i

 Set objOutlook = Nothing
 MsgBox "送信完了"

End Sub



'カレントフォルダのパスを求める関数
Public Function UrlToLocal(ByRef Url As String) As String

   'OneDrive環境変数を格納する変数の定義
    Dim OneDrive As String

   'OneDrive環境変数の取得
    OneDrive = Environ("OneDrive")

   '「https://･･･････/Documents」までの文字数を格納する変数の定義
    Dim CharPosi As String

   ' ＵＲＬからローカルパスを作成する
    If Url Like "https://*" Then 'OneDriveのパスかどうかの判定
           
      '「https://･･･････/Documents」までの文字数を取得
      CharPosi = InStr(1, Url, "/Documents") + 10
      
      'ローカルパス作成
      Url = OneDrive & Replace(Mid(Url, CharPosi), "/", Application.PathSeparator)
    
    Else
    
      'OneDriveのパス以外だったらカレントドライブ指定
      ChDrive Left(Url, 1)
     
    End If

  '作成したローカルパスを返す
   UrlToLocal = Url

End Function

VBA,メールExcel,Outlook,VBA,サンプルアプリ,マクロ,メール

Posted by CoderM