【Outlook VBA】返信時に宛名を自動挿入する方法!様・さん付けも!

Outlookの返信時に宛名を自動挿入したいときはないでしょうか。

けど、そんな中で悩むことは、

・Outlookの返信時に宛名を自動挿入したいがやり方がわからない。
・Outlook VBAでOutlookの返信時に宛名を自動挿入したいがやり方がわからない。

ですよね。

今回はそんなお悩みを解決する

・返信時に宛名を自動挿入する方法
・宛名を挿入と同時に様・さん付けもする方法

についてまとめます!

Outlookの返信時に宛名を自動挿入する完成イメージ

Outlookの返信時に宛名を自動挿入する完成イメージについて説明をします。

Outlookの返信時に宛名を自動挿入する機能はないため、VBAで作り込み実装していきます。

次にOutlookの連絡先にメールする人の連絡先を登録します。

返信したいメールを開き、

追加したマクロ実行ボタンからマクロを実行すると、

返信メールが作成され、その本文へ宛名が自動挿入されます!

さらに敬称の「様」や「さん」付けも自動で判断し、付け加えられます!

返信先のメールアドレスと連絡先のメールアドレスが一致したら、宛名情報を連絡先から取得し、メール本文に挿入するという訳です。

よくやり取りする人の連絡先を登録しておけば手作業で宛名を入力する必要はありませんね。

それでは早速使ってみましょう。

宛名となる情報をOutlookの連絡先に登録する

宛名となる情報をOutlookの連絡先に登録していきましょう。

今回使う項目は「姓」、「勤務先」、「部署」、「メール」となりますので漏れがないように入力しましょう。

Outlookの返信時に宛名を自動挿入するVBA

VBAを用意する

Outlookの返信時に宛名を自動挿入するVBAをOutlookへ追加します。

VBAの追加手順については「VBAの実装手順」を参考にしてください。

サンプルコードは以下の通りです。

Sub 選択メールを返信し宛名を挿入する()

'Outlook用の定義
    Dim olApp As Outlook.Application
    Dim olNamespace As Outlook.NameSpace
    Dim olFolder As Outlook.MAPIFolder
    Dim olConItems As Outlook.Items
    Dim olItem As Object

    Dim objReItem As Outlook.MailItem
    Dim strShanaiAddress As String
    Dim strSenderAddress As String
    
    '「さん」付け対象となる社内ドメインを設定します。
    strShanaiAddress = "extan.jp"
    
    'Outlookオブジェクトを設定し、MAPI名前空間を介してOutlookの連絡先一覧を取得します。
    Set olApp = New Outlook.Application
    Set olNamespace = olApp.GetNamespace("MAPI")
    Set olFolder = olNamespace.GetDefaultFolder(olFolderContacts)
    Set olConItems = olFolder.Items
    
    '現在表示中のメールアイテムを「返信」メールとしてセットします。
    Set objReItem = ActiveInspector.CurrentItem.Reply
    
    '現在表示中のメールアイテムの送信者のアドレスを取得します。
    strSenderAddress = ActiveInspector.CurrentItem.SenderEmailAddress
    
    '連絡先登録アイテムを取得し、登録件数分処理を実施します。
    For Each olItem In olConItems
    
        '連絡先と送信元メールアドレスが一致したら連絡先の情報を宛名として設定します。
        If TypeName(olItem) = "ContactItem" And strSenderAddress = olItem.Email1Address Then
            With olItem
            
                '敬称判定をします。社内アドレスの場合は「さん」、それ以外は「様」を付けます。
                If InStr(strSenderAddress, strShanaiAddress) Then
                    strAddBody = .Department & " " & .LastName & "さん"
                Else
                    strAddBody = .CompanyName & .Department & " " & .LastName & "様"
                End If

            End With
        End If
    Next olItem
    
    'メール本文に宛名を挿入します。
    objReItem.Body = strAddBody & vbCrLf & vbCrLf & objReItem.Body
    
    'メールアドレスの表示名を連絡先表示名と同期させます。
    objReItem.Recipients.ResolveAll
    
    '表示します。
    objReItem.Display
    
    '送信します。
    'objReItem.Send
    
    
    'オブジェクトの開放をします。
    Set objReItem = Nothing
    Set olApp = Nothing
    Set olNamespace = Nothing
    Set olFolder = Nothing
    Set olConItems = Nothing
    
End Sub

VBAを設定する

VBAを設定していきましょう。

「さん」付け対象となる社内ドメインを設定します。
例えば「***@extan.jp」が社内メンバーのアドレスだとすると「extan.jp」を指定します。

strShanaiAddress = “extan.jp”

VBAの実装手順

実装手順は以下の通りです。

「開発」タブ>「Visual Basic」を押します。

「Visual Basic Editor」にて、[Project1] > [Microsoft Outlook Objects] の ThisOutlookSessionをダブルクリックします。

右ペインのコードエリアへ、VBAコードを貼り付けて保存します。

こちらで完了です。

VBAの実行ボタンを配置する

VBAの実行ボタンをメール上部へ配置しましょう。

返信対象のメールを開き、上部バーの下矢印をクリックし「その他のコマンド」を選択します。

「クイックアクセスツールバー」をクリックします。

「コマンドの選択」でマクロを選択し、

一覧から該当するマクロを選択し、「追加」ボタンをクリックします。

追加できたら「OK」ボタンを押します。

返信対象尾メールのヘッダーにアイコンが追加されていることを確認します。

VBAを実行する

VBAを実行しましょう。

返信したいメールを開きます。

先ほど追加したメールヘッダーのアイコンをクリックします。

はい!宛名が挿入されていますね!

■内部「さん」付け

■外部「様」付け

VBAの説明

Outlookの返信時に宛名を自動挿入するVBAの内容について説明をします。

Outlookオブジェクトを設定し、MAPI名前空間を介してOutlookの連絡先一覧を取得します。

Set olApp = New Outlook.Application
Set olNamespace = olApp.GetNamespace(“MAPI”)
Set olFolder = olNamespace.GetDefaultFolder(olFolderContacts)
Set olConItems = olFolder.Items

現在表示中のメールアイテムを「返信」メールとしてセットします。

Set objReItem = ActiveInspector.CurrentItem.Reply

現在表示中のメールアイテムの送信者のアドレスを取得します。

strSenderAddress = ActiveInspector.CurrentItem.SenderEmailAddress

連絡先登録アイテムを取得し、登録件数分処理を実施します。

For Each olItem In olConItems

連絡先と送信元メールアドレスが一致したら連絡先の情報を宛名として設定します。

If TypeName(olItem) = “ContactItem” And ActiveInspector.CurrentItem.SenderEmailAddress = olItem.Email1Address Then

敬称判定をします。社内アドレスの場合は「さん」、それ以外は「様」を付けます。

If InStr(ActiveInspector.CurrentItem.SenderEmailAddress, strShanaiAddress) Then
strAddBody = .Department & ” ” & .LastName & “さん”
Else
strAddBody = .CompanyName & .Department & ” ” & .LastName & “様”
End If

タカヒロ
タカヒロ
内部「さん」付けは社名を除いた部署のみの表示としています。

メール本文に宛名を挿入します。

objReItem.Body = strAddBody & vbCrLf & vbCrLf & objReItem.Body

メールアドレスの表示名を連絡先表示名と同期させます。

objReItem.Recipients.ResolveAll

返信メールを表示します。

objReItem.Display

タカヒロ
タカヒロ
この時点ではまだメールは送信されません。送信をするためにはメソッドの追加が必要となり、別項目で説明をします。

「全員に返信」メールを作成し、宛名を追加する

これまで表示中のメールを「返信」メールとして作成していましたが、CCを含む場合など全員へ返信したい場合があります。

その全員へ返信する方法について説明をします。

変更する箇所は以下の「Reply」の部分を

Set objReItem = ActiveInspector.CurrentItem.Reply

「ReplyAll」にするだけです。

Set objReItem = ActiveInspector.CurrentItem.ReplyAll

「全員に返信」メールを作成し、宛名を追加する

CCに関係者を含めて全員へ返信したい場合がありますね。

CCに関係者を追加する方法について説明をします。

CCプロパティにセミコロン「;」区切りで追加したいメールアドレスを入力します。

コードは「ReplyAll」メソッドの下あたりに入れてもらえばと思います。

objReItem.CC = objReItem.CC & “;” & “test1@extan.jp”

送信する機能を追加する

これまで返信メールを表示させるまでを実行してきましたが、

次は表示させずに返信するように変更をしてみましょう。

方法はSendメソッドを追記するだけです。

タカヒロ
タカヒロ
即送信されますので、必ずテストアドレスなどを利用し検証をおこなってください。

objReItem.Send

既にサンプルコード中に入力されていますので、以下のようにSendメソッドをアクティブ、Displayメソッドを非アクティブにしてください。

‘表示します。
‘objReItem.Display
’送信します。
objReItem.Send

<修正版>連絡先にグループが含まれる場合に発生する438エラーを回避する

読者様より連絡先にグループが含まれる場合に438エラー「オブジェクトは、このプロパティまたはメソッドをサポートしていません。」が発生するご指摘を受け、修正をいたしましたので、原因の説明と修正版コードを公開いたします。

438エラー発生の原因

以下にて連絡先アイテムのタイプ判定と同時に連絡先と送信元メールアドレスが一致しているかチェックをしていますが、

TypeName(olItem) = "ContactItem" And strSenderAddress = olItem.Email1Address

連絡先グループの場合はEmail1Addressプロパティを持たないオブジェクトであるため、プロパティが拾えないとエラーとなります。
単純に連絡先アイテムのタイプ判定とメールアドレスの判定を同時にしていることが原因であるため、これを分けることによってエラーを回避していきます。

タカヒロ
タカヒロ
438エラーの原因と対処方法についての詳細はこちらをご参照ください。

VBA エラー 438「オブジェクトは、このプロパティまたはメソッドをサポートしていません。」の原因と対処方法

438エラー発生回避版のVBAコード

438エラー発生回避版のVBAコードは以下の通りとなります。

Sub 選択メールを返信し宛名を挿入する_改良版()

'Outlook用の定義
    Dim olApp As Outlook.Application
    Dim olNamespace As Outlook.NameSpace
    Dim olFolder As Outlook.MAPIFolder
    Dim olConItems As Outlook.Items
    Dim olItem As Object

    Dim objReItem As Outlook.MailItem
    Dim strShanaiAddress As String
    Dim strSenderAddress As String
    
    '「さん」付け対象となる社内ドメインを設定します。
    strShanaiAddress = "extan.jp"
    
    'Outlookオブジェクトを設定し、MAPI名前空間を介してOutlookの連絡先一覧を取得します。
    Set olApp = New Outlook.Application
    Set olNamespace = olApp.GetNamespace("MAPI")
    Set olFolder = olNamespace.GetDefaultFolder(olFolderContacts)
    Set olConItems = olFolder.Items
    
    '現在表示中のメールアイテムを「返信」メールとしてセットします。
    Set objReItem = ActiveInspector.CurrentItem.Reply
    
    '現在表示中のメールアイテムの送信者のアドレスを取得します。
    strSenderAddress = ActiveInspector.CurrentItem.SenderEmailAddress
    
    '連絡先登録アイテムを取得し、登録件数分処理を実施します。
    For Each olItem In olConItems
        '連絡先アイテムのタイプを確認します。
        If TypeName(olItem) = "ContactItem" Then
            '連絡先と送信元メールアドレスが一致したら連絡先の情報を宛名として設定します。
            If strSenderAddress = olItem.Email1Address Then
                With olItem
                
                    '敬称判定をします。社内アドレスの場合は「さん」、それ以外は「様」を付けます。
                    If InStr(strSenderAddress, strShanaiAddress) Then
                        strAddBody = .Department & " " & .LastName & "さん"
                    Else
                        strAddBody = .CompanyName & .Department & " " & .LastName & "様"
                    End If
    
                End With
            End If
        End If
    Next olItem
    
    'メール本文に宛名を挿入します。
    objReItem.Body = strAddBody & vbCrLf & vbCrLf & objReItem.Body
    
    'メールアドレスの表示名を連絡先表示名と同期させます。
    objReItem.Recipients.ResolveAll
    
    '表示します。
    objReItem.Display
    
    '送信します。
    'objReItem.Send
    
    
    'オブジェクトの開放をします。
    Set objReItem = Nothing
    Set olApp = Nothing
    Set olNamespace = Nothing
    Set olFolder = Nothing
    Set olConItems = Nothing
    
End Sub

438エラーが発生しないか確認する

連絡先にグループを追加して、改良版VBAを実行してみましょう。

エラーは発生しませんね。

さいごに

いかがでしょうか。

今回は、

・返信時に宛名を自動挿入する方法
・宛名を挿入と同時に様・さん付けもする方法

についてまとめました。

また、他にも便利な方法がありますので、よろしければご参照頂ければと思います。



この記事の関連キーワード

こちらの記事の関連キーワード一覧です。クリックするとキーワードに関連する記事一覧が閲覧できます。



タカヒロ

タカヒロ
実質無料で読めるExcelVBA本についてまとめました。
もしVBA本購入を検討されていたら、どれだけお得か確かめてみてください。

【¥0】実質無料のExcelVBAおすすめ本25選!初級~中級まで網羅!

7 件のコメント

  • タカヒロ様

    下記について対応することができました。
    大変助かりました。ありがとうございました。

  • 貴重な情報を提供して頂き、ありがとうございます。
    業務効率化の参考にさせて頂いています。
    下記についてご教示頂けると助かります。

    Outlookの「オプション」→「メール」→「返信/転送時に元のメッセージのウィンドウを閉じる」にチェックを入れた場合に対応するコードを追加することは可能でしょうか。

    • いつもご利用ありがとうございます。

      返信時に元のウインドウを閉じる処理を追加する方法につきまして、
      以下のように変更すれば可能となります。

      ■変更前
      ‘メールアドレスの表示名を連絡先表示名と同期させます。
      objReItem.Recipients.ResolveAll

      ‘表示します。
      objReItem.Display

      ■変更後
      ‘メールアドレスの表示名を連絡先表示名と同期させます。
      objReItem.Recipients.ResolveAll

      ‘元メールを確認メッセージなしで閉じます。
      Application.ActiveInspector.CurrentItem.Close olDiscard

      ‘表示します。
      objReItem.Display

      CloseメソッドとそのプロパティにolDiscardを指定することにより
      確認メッセージ無しで元ウインドウを閉じるようにしています。

      よろしくお願いいたします。

  • こんにちは。早速ご返信くださりありがとうございました。こちらでさらに調べたところ、どうやらご指摘の分岐ループのところで途中に連絡先グループ(メールアドレスをもたない)があるとエラーになっていたようです。

    試しに一度削除して作り直したところ olConItems の最終エントリーになったのでとりあえずエラーは回避できました。かといって初心者のため、メールアドレスのないエントリーを飛ばす処理は思いつきません。連絡先グループは一つしか使わないのでひとまずは解決したと思います。ありがとうございました。

    • ご連絡ありがとうございます。

      こちらでもグループが連絡先に存在する場合、438エラーが発生することが確認できましたので、
      バグと判断し、公開しているコードも修正させて頂きました。

      よろしくお願いいたします。

  • いつもさんこうにさせていただき大変有り難く存じます。
    こちらのコードですが、試したところ、自分のアドレス帳にある全部のエントリーをこえるとwith構文をネストしているIFのところで「VBA エラー 438「オブジェクトは、このプロパティまたはメソッドをサポートしていません。」がでてしまいます。なにかよい回避策はないでしょうか

    • いつもご利用ありがとうございます。

      438エラーですが、取得したオブジェクトに該当プロパティが存在しない場合に発生する内容ですので、
      以下のよう、オブジェクトタイプとプロパティ内容判定を一度にする方式から分ける方式に変更して検証頂けますでしょうか。

      ■変更前
      If TypeName(olItem) = “ContactItem” And strSenderAddress = olItem.Email1Address Then

      End If

      ■変更後
      If TypeName(olItem) = “ContactItem” Then
      If strSenderAddress = olItem.Email1Address Then

      End If
      End If

  • コメントを残す

    メールアドレスが公開されることはありません。 * が付いている欄は必須項目です