下書き保存したメールを一括送信するExcelVBA

メール作成の自動化でのジレンマを解消するツール
メールをたくさん作成した場合のその他の問題点
一括メール送信のVBAコードについて

メール作成の自動化でのジレンマを解消するツール

以前にこちらの記事でたくさんのメールを一度に作成するコードを紹介しました。

このメール作成機能は便利ですが、作成したメールを送信する手順は極端な2通りしかなく、1つは完全に自動で内容を見ずに送る方法、もう1つは内容をチェックした後に手で送信ボタンをクリックする方法で、他の方法はありませんでした。

できれば内容を確認したいのですが、手作業でたくさんのメールの送信ボタンを押し続けるのはかなり苦痛です。
例えば50件くらいを1回送るだけならメールの送信ボタンを押し続けても良いのですが、100件以上を毎日送ると考えると多くの方は嫌になってしまうと思います。

だからと言って内容を全くチェックせずに自動で送信するのもできれば避けたいところでした。

今回はこのジレンマを解消するため、作成したメールの中身をある程度確認しつつ、一括でメールを送信する機能を考えてみました。

メールをたくさん作成した場合のその他の問題点

たくさんのメールを作成した場合、送信のボタンを自分で押しまくるか、または全く内容を確認せずにメールを自動送信するかの判断に迫られること以外にも問題点があります。

それは作成したメールをすべて表示させたままにするとOutlookがフリーズすることがあります。
私の職場のPC環境では作成するメールの数が3桁になると強制終了してしまうことがありました。

そのため、私は下記のコードを用いて、作成したメールを一度下書き保存して閉じるようにしました。

Sub メールを作成したあと下書き保存する()

Dim oApp As New Outlook.Application
Dim oItem As Outlook.MailItem

Dim oAcct
Dim oStore

Set oItem = oApp.CreateItem(olMailItem)
oItem.SendUsingAccount = Session.Accounts(“メールアドレス”)
oItem.To = “〇〇〇〇@gmail.com”
oItem.CC = “××××@yahoo.co.jp”
oItem.Subject = “件名を入力”
oItem.HTMLBody = “” & “本文はこちら” & ““

oItem.Display ’送信せずに画面を表示する場合
oItem.Save ’下書き保存
oItem.Close 0 ’閉じる

Set oItem = Nothing

End Sub

このコードを使用すると作成したメールは下書きに保存され、閉じられるのでメール作成の動作が安定するようになりました。

一括メール送信のVBAコードについて

今回作成したメールを一括送信する流れは、下書き保存したメールをいくつか目で見てチェックし、きちんとメールが作成されているか確認した後、下書き保存されているメールを一括で送信するという流れを想定しています。

VBAで実行する内容は「下書き保存したメールをすべて送信する」ことです。
Excel上で下記のコードを実行すると下書き保存しているメールが順番に送信されます。

Sub 下書きメール全部送信()

Dim oApp As New Outlook.Application
Dim FSO As Object
Set FSO = CreateObject(“Scripting.FileSystemObject”)
Dim Path As String, WSH As Variant
Set WSH = CreateObject(“Wscript.Shell”)
Dim DesktopPath As String
DesktopPath = WSH.SpecialFolders(“Desktop”)

Dim oAcct
Dim oStore

Dim oFolder
Dim cITEM
Dim n As Integer, j As Integer, l As Integer

Set oAcct = oApp.Session.Accounts(“メールアドレス”)
Set oStore = oAcct.DeliveryStore

Set oFolder = oStore.GetDefaultFolder(16)

oFolder.Display

j = 0
l = 1

If oFolder.Items.Count = 0 Then
Exit Sub
End If

For n = 1 To oFolder.Items.Count
Set cITEM = oFolder.Items(l)
On Error GoTo 次の下書きメール送信
cITEM.Display
cITEM.Send ’送る場合
Set cITEM = Nothing
On Error GoTo 0

Next

Set oFolder = Nothing
Set FSO = Nothing

Exit Sub

次の下書きメール送信:

cITEM.Close 0
l = l + 1
Resume Next

End Sub

宛先の不備などで送信できないメールがあった場合は、エラー処理でメールをそのまま閉じて、次のメールを送信する流れにしています。

ExcelでOutlookの操作を行うには参照設定が必要です。
参照設定の方法についてはこちらの記事をご確認ください。