【VBAでOutlook操作】Excelシートのデータから下書きメールを一括作成する

ねぇもりさん、会社で毎日たくさんメールを出す作業があるんだ。ラクにできる方法ないかなぁ

もり

一斉送信はできないの？？

宛先ごとにメールの文面を変えるから、一件ずつ個別に送信しなきゃいけないんだ

もり

なるほどね～それならVBAでツールを作っちゃおう

メール本文がまったく同じ内容であればToやBccなどで一斉送信できますが、相手によってメールの文面を変えたい場合は、一通ずつメールを作成して個人宛に送信する必要がありますよね。

Excelシートに用意したデータを元に、Outlookの下書きメールを一括作成するマクロを紹介します。

作成した下書きメールは、下記のいずれかの処理ができます。

画面に表示させる
画面に表示はさせず、直接「下書き」フォルダに保存する
画面に表示はさせず、直接「送信」する

Contents

VBAでOutlookの下書きメールを一括作成する

VBAでOutlookの下書きメールを一括作成する

※この記事はVBAの基本操作を習得している方向けに書いているので、全般的な解説は省略しています。

【事前準備】Excelシートにデータを用意する

下記のようなフォーマットを用意します（※ご自身の業務要件に応じてフォーマットは調整してください）

シート名は「mail」としておきます。

A～E列：宛先と宛先ごとの情報
J列：固定情報

J列の「本文」は「ひな形」です。宛先毎に変更したい箇所を（）全角かっこでくくっています。

ひな形のこの部分をマクロで置き換えます。

（氏名）：C列の値に置換
（使用日）：D列の値に置換
（金額）：E列の値に置換

ソースコード

下記を標準モジュールに貼り付けます。

「ツール」→「参照設定」で「Microsoft Outlook XX.0 Object Library」を使用
事前にOutlookを起動しておき、mainプロシージャを実行

Enum col '列番号を定義
    宛先 = 1
    複写 = 2
    氏名 = 3
    使用日 = 4
    金額 = 5
    メール = 10
End Enum

Sub main()

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("mail")

    'Outlookオブジェクトの作成
    Dim OutlookObj As Outlook.Application
    Set OutlookObj = New Outlook.Application
    
    Dim r As Long, lastRow As Long
    lastRow = ws.Cells(1, 1).End(xlDown).Row
    
    For r = 2 To lastRow
    
        'メールアイテムオブジェクト作成
        Dim mailItemObj As Outlook.MailItem
        Set mailItemObj = OutlookObj.CreateItem(olMailItem)

        'メール本文の文字列を作成
        Dim mailBody As String
        mailBody = CreateMailBody(ws, r)
        
        'メールアイテム作成
        With mailItemObj
            'Outlookに複数アカウントを設定している場合、送信元アカウントを指定できる
            .SendUsingAccount = Session.Accounts("メールアドレスを記述") '省略可
            .To = ws.Cells(r, col.宛先).Value 'Toを設定
            .CC = ws.Cells(r, col.複写).Value 'CCを設定
            .Subject = ws.Cells(1, col.メール).Value '件名を設定
            .body = mailBody '本文を設定
        End With
        
        '下書きメールアイテムを表示
        mailItemObj.Display
        
        '次のメールアイテムを作成するためいったん破棄
        Set mailItemObj = Nothing
    
    Next r

End Sub

' 機能：Excelシート上の指定行番号のメール本文を作成する
Function CreateMailBody(ws As Worksheet, r As Long) As String

    Dim sName As String, DayOfUse As String, price As Long
    sName = ws.Cells(r, col.氏名).Value
    DayOfUse = ws.Cells(r, col.使用日).Value
    price = ws.Cells(r, col.金額).Value
    
    Dim sign As String '署名
    sign = ws.Cells(12, col.メール).Value
    
    Dim body As String 'メール本文
    body = ws.Cells(2, col.メール).Value '初期値を設定
    body = Replace(body, "（氏名）", sName)
    body = Replace(body, "（使用日）", DayOfUse)
    body = Replace(body, "（金額）", price)
    body = body & vbCrLf & vbCrLf & sign '末尾に署名を付与
    
    CreateMailBody = body

End Function

Enum col '列番号を定義

宛先 = 1

複写 = 2

氏名 = 3

使用日 = 4

金額 = 5

メール = 10

End Enum

Sub main()

Dim ws As Worksheet

Set ws = ThisWorkbook.Sheets("mail")

'Outlookオブジェクトの作成

Dim OutlookObj As Outlook.Application

Set OutlookObj = New Outlook.Application

Dim r As Long, lastRow As Long

lastRow = ws.Cells(1, 1).End(xlDown).Row

For r = 2 To lastRow

'メールアイテムオブジェクト作成

Dim mailItemObj As Outlook.MailItem

Set mailItemObj = OutlookObj.CreateItem(olMailItem)

'メール本文の文字列を作成

Dim mailBody As String

mailBody = CreateMailBody(ws, r)

'メールアイテム作成

With mailItemObj

'Outlookに複数アカウントを設定している場合、送信元アカウントを指定できる

.SendUsingAccount = Session.Accounts("メールアドレスを記述") '省略可

.To = ws.Cells(r, col.宛先).Value 'Toを設定

.CC = ws.Cells(r, col.複写).Value 'CCを設定

.Subject = ws.Cells(1, col.メール).Value '件名を設定

.body = mailBody '本文を設定

End With

'下書きメールアイテムを表示

mailItemObj.Display

'次のメールアイテムを作成するためいったん破棄

Set mailItemObj = Nothing

Next r

End Sub

' 機能：Excelシート上の指定行番号のメール本文を作成する

Function CreateMailBody(ws As Worksheet, r As Long) As String

Dim sName As String, DayOfUse As String, price As Long

sName = ws.Cells(r, col.氏名).Value

DayOfUse = ws.Cells(r, col.使用日).Value

price = ws.Cells(r, col.金額).Value

Dim sign As String '署名

sign = ws.Cells(12, col.メール).Value

Dim body As String 'メール本文

body = ws.Cells(2, col.メール).Value '初期値を設定

body = Replace(body, "（氏名）", sName)

body = Replace(body, "（使用日）", DayOfUse)

body = Replace(body, "（金額）", price)

body = body & vbCrLf & vbCrLf & sign '末尾に署名を付与

CreateMailBody = body

End Function

【実行結果】下書きメールが作成される

Excelシートの行数分、下書きメールが作成されます。

【参考】下書きフォルダに保存する・直接送信する

上記で紹介したコードは「下書きアイテムの作成」ですが、「送信」or「保存」もマクロで実行することができます。

43行目のメソッドを書き換えます。

・下書きフォルダに保存する場合

mailItemObj.Display　→　mailItemObj.Save

・直接送信する場合（※必ず事前にテストして、誤送信のないようお気をつけください）

mailItemObj.Display　→　mailItemObj.Send

以上です！

ねぇもりさん、添付ファイルも付けられないかなぁ？

もり

できるよ～！次の記事で紹介するね！

【VBAでOutlook操作】複数ファイルを添付できる！下書きメールを一括作成するマクロExcelシートのデータを元に、Outlookの下書きメールを一括作成するマクロです。キーワードに一致する複数ファイルをまとめて添付できるのがポイントです ...

VBA

【VBAでOutlook操作】Excelシートのデータから下書きメールを一括作成する

VBAでOutlookの下書きメールを一括作成する

【事前準備】Excelシートにデータを用意する

ソースコード

【実行結果】下書きメールが作成される

【参考】下書きフォルダに保存する・直接送信する

【ExcelVBA】テキストファイルを取り込んでエクセルシートに書き出すマクロ

【ExcelVBA】許可ユーザーのみがマクロを実行できるよう制限する

【ExcelVBA】Findメソッドでセル範囲を検索する

IMPORT

ノーコード爆速アプリ開発ができるAppSheetで旦那語録を作ってみた

【GAS】スプレッドシート上でChatGPTを再現する（OpenAIのAPI使用）

【GAS×ChatGPT API連携】スプレッドシートで使えるリライトツールの作り方

まるで人間？ChatGPTの日本語翻訳が自然すぎる【ChatGPT活用法#1】