Outlookの返信メールを作成するExcelVBAコード

スポンサーリンク

届いたメールに対しての返信メールを作成するツールが欲しい

以前からメールを一括作成して差し込み印刷のようにメールを送る方法をはじめ、Outlookを用いてメールを作成するVBAコードをいくつかご紹介していましたが、これらのコードはすべてメールを新規に作成するものでした。

私の職場は部署(営業所みたいな感じ)が多く、あちらこちらとやり取りをする必要があるためメールがかなり多いです。

同じような問い合わせのメールを何度も受けたり、あらかじめ決まったフォーマットを添付してもらうはずなのにメール本文にベタ打ちされていたりして、同じ内容の文言を何回も送ることに追われていました。

そこで今回は返信メールを作成するVBAコードを考えて少しでも作業負担を減らそうという試みです。

返信メール作成ツールの条件

私が想定している返信メール作成ツールの条件は下記の通りです。

  • ①返信したいメールを選択している状態で簡単に作成できること
  • ②差出人名から宛名(メール本文の一番最初の「〇〇さん」と書く部分)を自動で作成すること
  • ③返信メールの差出人のメールアカウントを選択できること(メールアカウントを使い分けたい)
  • ④メール本文のパターンは複数登録でき、必要に応じて使い分けできること
  • 当初ボタン1つですぐに実行できるようにOutlookVBAで作成しようかと考えていたのですが、メール本文を複数登録して使い分けできるようにすることを考えてExcelVBAを使用することにしました。

    ユーザーフォームを使って作っても良かったのですが、本文の新規登録・修正にVBAの知識が必要になるのでExcelのワークシートを用いる方針にしました。
    他の条件を設定するのにもExcelのワークシートを用いるのが便利だし、複数の本文はシートをコピーして簡単に作成できます。
    やっぱりVBAの中でもExcelVBAは汎用性が高く使いやすいです。

    スポンサーリンク

    返信メール作成ツールのワークシートについて

    返信メール作成ツールのワークシートは下記のように作成しました。

    123-1Excel表

    返信メールの作成に当たってパターンを分けたい内容に関してはワークシートに記載します。
    今回作成したシートでは「To」「CC」「件名」「本文」「差出人アカウント名」をパターン分けの項目として作成しています。

    シートをコピーして本文を用意することで色々なパターンの返信を作成することが可能です。

    返信メール作成ツールのExcelVBAコード

    返信メール作成VBAコードについては「ActiveExplorerメソッド」を使用します。

    oApp.ActiveExplorer.Selection.Items(1)で選択しているメールの1つ目を指定します。
    インデックス番号は1から開始されるようです。

    Sub 返信メール作成()

    Dim 本文

    本文 = ActiveSheet.Cells(5, 2)
    本文 = Replace(本文, vbLf, “<br />”) ’本文の改行文字をHTML用に

    Dim oApp As New Outlook.Application
    Dim objItem As Outlook.MailItem
    ’選択しているメールのMailItemオブジェクトを取得
    Set objItem = oApp.ActiveExplorer.Selection.Item(1) ’インデックスは1番から開始

    Dim objReply As Outlook.MailItem
    Set objReply = objItem.Reply
    ’Set objReply = objItem.ReplyAll ’全員へ返信の場合

    If Cells(6, 2) <> “” Then ’送信アカウントの設定が必要な場合
    objReply.SendUsingAccount = Session.Accounts(Cells(6, 2).Text)
    End If

    If Cells(2, 2) <> “” Then ’Toの設定 置き換えではなく追加
    objReply.To = objReply.To & “; ” & Cells(2, 2)
    End If

    If Cells(3, 2) <> “” Then ’CCの設定 置き換えではなく追加
    objReply.CC = objReply.CC & “; ” & Cells(3, 2)
    End If

    If Cells(4, 2) <> “” Then ’件名の設定 置き換え
    objReply.Subject = Cells(4, 2)
    End If

    宛名 = objItem.SenderName & “<br />” & “ご担当者さま”

    objReply.HTMLBody = “<font size=2.8>” & 宛名 & “<br /><br />” & 本文 & “</font size>” & objReply.HTMLBody

    objReply.Display ’画面を表示する
    objReply.Save ’下書き保存
    ’objReply.Close 0 ’閉じる

    Set objReply = Nothing
    Set objItem = Nothing

    End Sub

    Outlook Object Libraryの参照設定にチェック必要です。
    参照設定の手順はこちらを参考にしてください。

    コメント