Outlookで一覧表の全員にメールを送信する方法
今回の目標
Outlook(classic) で一覧表の全員にメールを送信する方法について解説します。
新年のあいさつなどやＤＭを送る際に参考になるかと思います。
目標リスト
- 一覧表の全員にメールを送信できるようになる
Outlookで送る方法について
事前準備
この記事は基本的なメール送信ができる前提で進めます。
基本的な操作が分からない方は次の記事をお読みください。
【リンク】
Outlookでメールを送信する方法
プログラムについて
今回はサンプルを用いて説明します。
メールの本文やタイトル、宛先、顧客名をシートに書きだします。
[メール]シートのセルＣ２にタイトル、セルＣ３に本文を記載しています。
先方の会社名及び顧客名・所属部署は別で設定するので、本文に記載しないようにします。
[取引先一覧]シートのＦ列にメールアドレス、Ｅ列に担当者名、Ｄ列に所属部署を記載しています。
メールオブジェクトを For 文の前で取得すると、1つのメールを更新するとなってしまい、メールが１つしか作成されません。
そのため、メールを For 文の中でメールオブジェクトを作成しましょう。
Outlookで一覧表の全員にメールを送信する
サンプルプログラムです。
メールを下書きしていますが、"With olMail"のブロック内のコメントの通り「.Save」を「.Send」とするとメールを送信できます。
テストが終わって問題なく動作することを確認してから、「.Send」に変更してください。
サンプルコード
Sub OutlookMailMultiple()
Dim olApp As Object
Dim olMail As Object
Dim mailWs As Worksheet
Dim recWs As Worksheet 'recipientName
Dim i As Long
Dim endRow As Long
Dim bodyTemplate As String
Dim recName As String
' Outlookオブジェクトを取得する
Set olApp = CreateObject("Outlook.Application")
' シートオブジェクトを取得する
Set mailWs = ThisWorkbook.Worksheets("メール")
Set recWs = ThisWorkbook.Worksheets("取引先一覧")
'リストの最終行を取得する
endRow = recWs.Cells(Rows.Count, 2).End(xlUp).Row
For i = 4 To endRow
'宛名を設定する
recName = recWs.Cells(i, 3) & vbCrLf
recName = recName & recWs.Cells(i, 4) & " " & _
recWs.Cells(i, 5) & "様" & vbCrLf
'宛名と本文を結合する
bodyTemplate = recName & vbCrLf & mailWs.Range("C3")
'メールを作成する
Set olMail = olApp.CreateItem(0)
With olMail
.To = recWs.Cells(i, 6)
.Subject = mailWs.Range("C2")
.Body = bodyTemplate
.Save '← 確認せず、送信する場合「.Send」とする
End With
'念のため、オブジェクトを解放
Set olMail = Nothing
Next i
Set olApp = Nothing
End Sub出力結果
取引先一覧の全員宛に下書きを作成します。
確認する時は Outlook を開いてください。
※ プログラム実行後に、Outlook を表示させていません。
