【Outlook VBA】カンタン!送信する宛先のドメイン毎に署名を切り替える

前回の

【Outlook VBA】送信前に入力した宛先に指定外ドメインが含まれるか確認する方法


のドメイン判定ロジックを利用してドメイン毎に署名を切り替える処理をご紹介します。

署名ってよく間違えませんか

今や仕事のシェアード化が進み、また請負先へ常駐していたりなど一人2、3役で様々な顔を使い分けて仕事をするケースが多いかと思います。

タカヒロもよくやってしまうのはメールの署名を社外向けとすべきが社内向けになったり間違えてしまうことです。

端末も複数のPCを利用している場合は特に発生しやすいです。

メール誤送信には該当しないので、まあいいか、で済ましていますが、、受け手に対してはあまりよろしくありません。

そこで社内ドメインを定義しそれに該当する場合は社内の署名、該当しない場合は社外の署名に切り替えられるようなVBAを作ってみたいと思います。

マクロを設置する下準備をする。

以下を参考にVBAコードを配置する場所を表示させます。

Outlook VBAをはじめよう!初心者向け手引き

マクロを登録する

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

「Visual Basic Editor」にて、[Project1] > [Microsoft Outlook Objects] > [ThisOutlookSession] を開きます。

右のコードエリアへ、以下のコードを貼り付けて保存します。

Public Sub 署名変更()

    '社内用と社外用の署名を定義
    Const signature1 = "(社内)〇〇部 えくた たろう(#内線)"
    Const signature2 = "------------" & vbCrLf & "(社外)〇〇〇株式会社 〇〇部〇〇課" & vbCrLf & "えくた たろう(#代表番号)"
    
    Dim myDomainList As Variant
    Dim checkNum As Long
    Dim Item As Object
    Dim recips As Object
    Dim pa As Object
    Dim senderDomainList As Variant
    Dim bookmark As Object
    Dim signature As Object
    
    'チェックナンバー初期化
    checkNum = 0
    
    '指定ドメイン(社内ドメインとして定義します。該当しない場合は社外とします。)
    myDomainList = Array("extan.jp", "extan2.jp")
    
    'outlookオブジェクトの名前空間を指定
    Const PR_SMTP_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
    Set Item = ActiveInspector.CurrentItem
    Set recips = Item.Recipients
    
    '宛先のSMTPアドレスを取得
    Set pa = recips(1).PropertyAccessor
    'ドメインだけにする
    senderDomainList = Split(pa.GetProperty(PR_SMTP_ADDRESS), "@")
    
    '社内ドメインと宛先のドメインが一致しているかチェック 一致した場合は1を代入。
    For i = 0 To UBound(myDomainList)
        If myDomainList(i) = senderDomainList(1) Then
            checkNum = 1
        End If
    Next
    
    '本文のオブジェクトを取得
    Set bookmark = ActiveInspector.WordEditor
    '署名のオブジェクトを取得
    Set signature = bookmark.Bookmarks("_MailAutoSig")
    
    '署名の置き換え
    If checkNum = 1 Then
        signature.Range.Text = signature1
    Else
        signature.Range.Text = signature2
    End If

    'オブジェクトの開放
    Set Item = Nothing
    Set bookmark = Nothing
    Set signature = Nothing
    
End Sub

試しに署名が切り替えられる確認をする

コードの説明はさておき、早速チェックされるか確認をしてみましょう。

新規にメールを作ります。

ホワイトリストに社内ドメイン”extan.jp”, “extan2.jp”を指定していますので、宛先にそのドメインが含まれるアドレスを挿入します。

なお、署名はデフォルトで入るようにしてください。デフォルトの署名がない場合は署名を入れる場所が取得できずエラートなるからです。
次に「開発」タブ>「マクロ」から「署名変更」ボタンを押します。

はい!署名が社内向けに変更されましたね。

社外の場合も確認したいので社内ドメイン以外のアドレスを指定して、マクロ実行。
はい!署名が社外向けに変更されましたね。

さいごに

いかがでしょうか。マクロから選択することが面倒である場合はマクロボタンをメニューに追加したり、送信ボタン押下時に自動実行されるようにしてもいいかもしれませんね。

次回もいろいろな使い方をとりあげていきたいと思います!



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

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







2 件のコメント

  • 署名変更のコードの情報提供ありがとうございます。
    私のOutlookでは★の行で以下のエラーが表示されて機能しませんでした。
    何か原因ありますでしょうか?
    (申し訳ありませんが、当方ExcelVBAは初級レベル、OutlookVBAは全くのド素人です。簡単な解説をいただけると助かります。よろしくお願いいたします。)

    実行時エラー’91
    オブジェクト変数またはWithブロック変数が設定されていません。

    ‘outlookオブジェクトの名前空間を指定
    Const PR_SMTP_ADDRESS As String = “http://schemas.microsoft.com/mapi/proptag/0x39FE001E”
    Set Item = ActiveInspector.CurrentItem ★
    Set recips = Item.Recipients

    なお、ページに記載されたコードは、以下1か所以外基本的に変えていません。
    ‘チェックナンバー初期化
    checNum = 0 → checkNum = 0  定義に合わせた誤記修正

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

      実行時のエラー91につきまして、
      新規/返信メールが別ウインドウで表示されているか確認頂けますでしょうか。

      ActiveInspector.CurrentItemは今開いている子ウインドウのアイテムが対象となりますので、
      子ウインドウがない場合(Outlook本体のみである状態)は取得できずエラーとなります。

      また変数名ミスの件は申し訳ありません。
      記事のコードを修正させて頂きました。

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

  • コメントを残す

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

    CAPTCHA ImageChange Image