ExcelVBAでメールの作成と管理を自動化する

概要

ExcelVBAを使用してメールを雛形どおりに自動作成し、送信日時やタスクを管理します。

特徴

・基本情報で入力した内容をもとに各雛形からメールを自動作成します
・メール雛形は無限に作成可能
・送信日時は作成した日付が自動入力され、同時に完了したタスクはグレーアウトします
・添付ファイルは基本情報で入力したパスと指定したファイル名から自動添付されます。
　(パスが未入力の場合は実行ファイルと同じ場所からファイルが添付れさます)
・送信アカウントは自由に変更可能
・基本情報で設定できる項目は「送信アカウント」「企業・所属名」「担当者名」「メールアドレス」「共有フォルダパス」「添付ファイルパス」「プロジェクト情報」などのほか、必要な項目があれば自由に追加が可能。また、宛先やCC、メール本文の宛名も基本情報をもとに自動作成されます。

完成イメージ

初期設定シート

必要な項目のみ入力します。
未入力の項目は基本情報に追加されません。
また、他に必要な項目があれば簡単に追加することができます。(項目行を追加するのみ)

送信アカウントが未入力の場合は既定値に設定しているアカウントが自動で選択されます。

メール作成シート

指定した雛形でメールを自動作成し、送信日時やタスクを管理できます。

雛形の例(本文)

基本情報で設定したキーと値をもとに雛形に含まれるキーがすべて変換され、以下のように新規メールが自動作成されます。

一度メール作成ボタンを押すと送信日時が自動入力され、タスクがグレーアウトします。
同じタスクは何度でも実行可能で送信日時は上書きされます。
(送信日時を削除するとグレーアウトは解除)

もちろん、添付ファイルの追加も可能です。

自作VBAプログラム(マクロ)を公開

サンプルファイルのダウンロード

VBAコード

Option Explicit

Sub myMailsend()
    'OUTLOOKオブジェクトの作成
    Dim my_mail As Outlook.Application
    Set my_mail = New Outlook.Application
    '以下は参照設定を使用しない場合の設定
    'Dim my_mail As Object
    'Set my_mail = CreateObject("Outlook.Application")
    Dim sendobj As Outlook.MailItem
    Set sendobj = my_mail.CreateItem(olMailItem)
    
    '変数定義
    Dim i As Long 'ループ処理用
    Dim int_data '初期設定データの連想配列
    Dim key As Variant '連想配列のキー
    Dim ob As String '選択されたオプションボタン
    Dim ob_no As Long '実行する項目番号
    Dim cc_data As String 'CCデータ
    Dim subject_data As String '件名データ
    Dim body_data As String '本文データ
    Dim file_data As String '添付ファイルパス
    
    '設定用シートの初期設定データを連想配列に格納
    Set int_data = CreateObject("Scripting.Dictionary")
    With Sheets("初期設定")
        For i = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
            If .Cells(i, 2) <> "" Then
                int_data.Add .Cells(i, 1).Value, .Cells(i, 2).Value
            End If
        Next
    End With
    
    '選択されているメールの作成
    With Sheets("メール作成")
        ob_no = 0
        For i = 1 To .Cells(Rows.Count, 2).End(xlUp).Row - 1
            ob = "OptionButton" & CStr(i)
            If .OLEObjects(ob).Object.Value = True Then
                ob_no = i '選択されているオプションボタンの番号を取得
                Exit For
            End If
        Next
        subject_data = .Cells(ob_no + 1, 3).Value
        body_data = .Cells(ob_no + 1, 4).Value
        For Each key In int_data
            If InStr(subject_data, key) > 0 Then
                subject_data = Replace(subject_data, key, int_data(key)) '件名に含まれるキーを変換
            End If
            If InStr(body_data, key) > 0 Then
                body_data = Replace(body_data, key, int_data(key)) '本文に含まれるキーを変換
            End If
        Next
        'CCへの追加と本文宛名の変換
        cc_data = ""
        If int_data.Exists("$担当者名2$") Then
            cc_data = cc_data & int_data("$メールアドレス2$") & ";"
        Else
            body_data = Replace(body_data, "CC：" & int_data("$所属名$") & " " & "$担当者名2$" & "様" & "、", "")
        End If
        If int_data.Exists("$担当者名4$") Then
            cc_data = cc_data & int_data("$メールアドレス4$") & ";"
            If int_data.Exists("$担当者名5$") Then
                cc_data = cc_data & int_data("$メールアドレス5$")
            Else
                body_data = Replace(body_data, "、" & "$担当者名5$", "")
            End If
        Else
            If int_data.Exists("$担当者名2$") Then
                body_data = Replace(body_data, "、" & "当社：" & "$担当者名4$" & "、" & "$担当者名5$", "")
            Else
                body_data = Replace(body_data, "(" & "当社：" & "$担当者名4$" & "、" & "$担当者名5$" & ")", "")
            End If
        End If
        '添付ファイルの取得
        If .Cells(ob_no + 1, 5).Value <> "" Then
            If int_data.Exists("$添付フォルダパス$") Then
                file_data = int_data("$添付フォルダパス$") & "\" & .Cells(ob_no + 1, 5).Value
            Else
                file_data = ThisWorkbook.Path & "\" & .Cells(ob_no + 1, 5).Value
            End If
            If Dir(file_data) = "" Then
                MsgBox "添付ファイル名やパスを確認してください"
                End
            End If
            sendobj.Attachments.Add Source:=file_data
        End If
        If InStr(body_data, "$送信日時$") > 0 Then
            body_data = Replace(body_data, "$送信日時$", Format(.Cells(ob_no, 6).Value, "m" & "/" & "d"))
        End If
        .Cells(ob_no + 1, 6).Value = Format(Date, "yyyy/mm/dd") '送信日時の登録
    End With
    
    'メール作成画面(送信前)
    With sendobj
        If int_data.Exists("$送信アカウント$") Then
            .SendUsingAccount = Session.Accounts.Item(int_data("$送信アカウント$"))
        End If
        .To = int_data("$メールアドレス1$")
        .CC = cc_data
        .Subject = subject_data
        .Body = body_data
        .BodyFormat = olFormatPlain
        .Display
    End With
    End '連続実行時のエラー回避用(OUTLOOKを起動していない場合)
End Sub

VBAプログラムについて解説

ExcelVBAでOUTLOOKを操作するやり方はとても簡単なので、ここでの説明は割愛します。
メール本文冒頭の宛名作成は、雛形から不要なキーを削除する方式にしていますが、逆に追加する方式に変えてもいいと思います。他に宛名をまるごと部品化する方法もあります。

自分なりに意識して取り組んだこと

正直、ExcelVBAによるメール送信自動化は初歩的かつド定番の内容となるため、特に意識して取り組んだことはありませんが、あえて言うなら連想配列の使い方を少し工夫したことぐらいでしょうか。
やはり自分自身が楽しみながら作るのが一番だと思います。