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

メール誤送信は個人だけの問題ではなく会社や組織の信用を失う事態まで発展しかねない重大事故として取り扱われているケースが多いかと思います。

けど、いくら注意をしていたとしても、日々膨大なメールを利用していると、ヒヤリとする機会は多々あるでしょう。

今回は前回の「送信前に入力した宛先を確認するメッセージを表示する方法」に続き、指定外ドメインが含まれるかチェックする方法を紹介したいと思います。

【Outlook VBA】カンタンに送信前に入力した宛先を確認するメッセージを表示する

指定外ドメインが含まれるかチェックする意図について

メール誤送信はどの企業でも重大事故として取り扱われますが、その中でも特にインパクトが大きいことは社外へ情報が漏れてしまうことではないでしょうか。

その発生要因となるところは社外のアドレスにメールを送信する場合に起こります。パスワードなしの添付ファイルがあったならば被害はさらに拡大するでしょう。

一方でメール誤送信をした先が社内であった場合、当然影響範囲は社内にとどまるので被害は限定的ですね。

社外に送信させないか、限定する。

社外と位置付ける指定以外のドメインのメールアドレスが含まれるかどうかを送信前にチェックする意図はそこにあります。

指定外ドメインに対して制御を行うことによりリスクを抑えることができるのです。

指定外ドメインをチェックする方法について

今回の方法は、警戒をする必要がない、つまり社内ドメインなど安全であるドメイン一覧を用意して、そのドメインに該当しない場合は警告メッセージをメール送信前に表示する仕組みを採用しました。
ちなみにIT用語ではこの警戒をする必要がない一覧をホワイトリストと呼びます。反対に警戒が必要な一覧をブラックリストといいます。

なお、ブラックリスト方式はホワイトリスト方式に比べ汎用性がある一方で警戒する必要があるドメインを大量に用意しなければならず、ブラックリストに定義されていないドメインはスルーされてしまう欠点があります。

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

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

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

マクロを登録する

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

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

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

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

    Dim mailTo As Variant
    Dim mailCc As Variant
    Dim WanMsg As String
    Dim WanMsg2 As String
    Dim myDomainList As Variant
    Dim myDomain As Variant
    Dim checkNum As Long
    Dim recips As Object
    Dim recip As Object
    Dim pa As Object
    Dim paAddr As Variant
    
    
    'チェックナンバー初期化
    checNum = 0
    
    '指定ドメイン(ホワイトリストです。カンマ区切りでドメインを追加することができます。)
    myDomainList = Array("extan.jp", "extan2.jp")
    
    'Itemオブジェクトから宛先を取得
    mailTo = Item.To
    mailCc = Item.CC

    '宛先を配列へ格納
    mailTo = Split(mailTo, ";")
    mailCc = Split(mailCc, ";")
    
    WanMsg = "▼宛先は" & vbCrLf
    
    For i = 0 To UBound(mailTo)
        WanMsg = WanMsg & "To:" & mailTo(i) & vbCrLf
    Next i
    
    For i = 0 To UBound(mailCc)
        WanMsg = WanMsg & "Cc:" & mailCc(i) & vbCrLf
    Next i
    
    'outlookオブジェクトの名前空間を指定
    Const PR_SMTP_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
    
    Set recips = Item.Recipients
    
    'SMTPアドレスを取得
    For Each recip In recips
        Set pa = recip.PropertyAccessor
        
        'ホワイトリストに該当するドメインであるかチェック
        For Each myDomain In myDomainList
            If InStr(pa.GetProperty(PR_SMTP_ADDRESS), myDomain) <> 0 Then
                checkNum = checkNum + 1
            End If
        Next
        
        'ホワイトリストに含まれない場合は警告メッセージ変数に追記
        If checkNum = 0 Then
            WanMsg2 = WanMsg2 & "SMTP:" & pa.GetProperty(PR_SMTP_ADDRESS) & vbCrLf
        End If
        
        checkNum = 0
        
    Next
    
    WanMsg = WanMsg & "が含まれています。" & vbCrLf
    
    If WanMsg2 <> "" Then
    WanMsg = WanMsg & vbCrLf & "▼以下は指定外ドメインです。再確認してください。" & WanMsg2 & vbCrLf
    End If
    
    WanMsg = WanMsg & "上記宛先へメールを送信してもよろしいですか?" & vbCrLf & vbCrLf
    
    If MsgBox(WanMsg, vbYesNo + vbExclamation) = vbNo Then
        Cancel = True
        Exit Sub
    End If
    
    Set Item = Nothing

End Sub

試しにサンプルメールを作りチェックされるか確認をする

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

適当なメールを作り、宛先、件名を入力します。
今回はホワイトリストにドメイン”extan.jp”, “extan2.jp”を指定していますので、それ以外のドメインがあれば警告メッセージが表示される結果となります。
なお、使用環境に合わせて上記ソースコードのホワイトリストのドメインおよびメール本体の宛先を変えれば、その条件で機能します。

次に「送信」ボタンを押します。

そうすると警告メッセージが表示されたかと思います。

よく見てみると…
はい!指定外ドメインの警告が表示されましたね。

問題なければ「はい」を、訂正したい場合は「いいえ」を押します。

 

VBAの説明

今回のVBAについて説明をします。

Private Sub Application_ItemSendはOutlookのメール作成時における送信ボタンを押下したときに発生するイベントとなります。ここは前回と同様ですね。

【Outlook VBA】カンタンに送信前に入力した宛先を確認するメッセージを表示する

引数に指定されている「Item」は送信メールの情報が入っているオブジェクト型の変数です。
この「Item」の中にある宛先アドレスとCcアドレスを取得し、それぞれの変数へ格納しています。

次にアドレスが複数ある場合、”;”区切りでつながった情報で格納されているため、”;”を区切り文字にし配列へ格納しています。

今回の機能であるホワイトリスト内に含まれるドメインであるかをチェックを行います。
通常宛先をオブジェクトから取得すると表示名のほうの値が入るので、今回は以下のサイトを参考に@マーク付きのSMTPアドレスのを取得するようにしています。

参考:受信者の電子メールアドレスを取得する

こちらにもカンタンに解説していますのでご参考ください。

【Outlook VBA】カンタン!宛先のSMTPアドレスを取得する

その後警告メッセージにアドレスの変数の内容を表示させ、”はい”の場合はそのまま送信、”いいえ”の場合は引数のCancelでTrueを設定し送信中止となるようにしています。

さいごに

最近の情報漏洩リスクを考えると送信前のチェックは念には念を入れたほうがよいですね。
各利用状況に応じてチェックすべき内容をリストアップし機械的にチェックできるようカスタマイズしていく使い方が望ましいのかもしれません。



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

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








2 件のコメント

  • 質問なのですが

    For i = 0 To UBound(mailTo)
    WanMsg = WanMsg & “To:” & mailTo(i) & vbCrLf
    Next i

    では、”▼宛先は”が表示されるかと思いますが、そうならない説明をお願いします

    • ご質問ありがとうございます。

      ”▼宛先は”が表示されない件につきまして、
      Outlookのマクロが有効化されていないか、コードが[ThisOutlookSession] 以外に
      配置されている可能性がありますのでご確認いただけますでしょうか。

  • コメントを残す

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