Outlookで社外へのメール誤送信を防止する

はじめに

社内あてに送ったメールに社外の人が含まれてるってよくありますよね。

・・・ぇ？無いですか。
そういうチェックが完璧な方は全然問題ないと思いますが、間違えて送ってしまうなんてことあると思います。
だってにんげんだもの。

そんな誤送信を防止する仕組みを考えてみました。

参考にした記事

Outlookはよく使われているので、参考記事はそこそこ見つかりました。

【誤送信防止】Outlookにて、社外秘メールの送り先に社外アドレスが含まれていないかチェック

Outlookで宛先をチェック・制限するマクロ

OutlookもVBAを動かすことができるので、送信のタイミングでドメインをチェックすれば社内・社外の判定ができそうです。

LegacyExchangeDN (X.500)

と思ってさらっとマクロ改造して動かしたら、よくわからんアドレスが出てきました。

Exchange環境下でのOutlookはSMTP形式([e-mail])の一般的なメールアドレスではなく

/o=組織名/ou=管理グループ/cn=Recipients/cn=名前またはエイリアス

で示されるLegacyExchangeDNという形式で管理されるらしい。

Exchange 環境における電子メール アドレス = LegacyExchangeDN

ということでExchange環境下も社内宛として、条件追加して以下の感じにマクロ作りました。

コード

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

Const CHECK_DOMAIN = "xxx.com"  'ドメイン判定用
Const CHECK_EXCHANGE = "/o=exchangelabs/" 'LegacyExchangeDN判定用

Dim RECV_INFO As Object
For Each RECV_INFO In Item.Recipients
    Dim ATESAKI As String, DOMAIN As String, ATE_LIST As String
    If RECV_INFO.AddressEntry.Members Is Nothing Then
        'メールアドレス直接の場合
        ATESAKI = RECV_INFO.Address
        DOMAIN = LCase(Right(ATESAKI, Len(ATESAKI) - InStr(ATESAKI, "@")))
        If DOMAIN <> CHECK_DOMAIN Then
            If LCase(Left(ATESAKI, InStr(2, ATESAKI, "/"))) <> CHECK_EXCHANGE Then
                ATE_LIST = ATE_LIST & ATESAKI & vbCr
            End If
        End If
    Else
        '連絡先グループの場合
        Dim MEMBER As Object
        For Each MEMBER In RECV_INFO.AddressEntry.Members
            ATESAKI = MEMBER.Address
            DOMAIN = LCase(Right(ATESAKI, Len(ATESAKI) - InStr(ATESAKI, "@")))
            If DOMAIN <> CHECK_DOMAIN Then
                If LCase(Left(ATESAKI, InStr(2, ATESAKI, "/"))) <> CHECK_EXCHANGE Then
                    ATE_LIST = ATE_LIST & ATESAKI & vbCr
                End If
            End If
        Next MEMBER
    End If
Next RECV_INFO

If ATE_LIST <> "" Then
    Dim ALERT_MSG As String
    ALERT_MSG = "社外アドレス" & vbCr & vbCr & _
    ATE_LIST & vbCr & _
    "が含まれています。" & vbCr & "送信しますか？" & vbCr

    If MsgBox(ALERT_MSG, vbYesNo + vbExclamation) = vbYes Then

    Else
        Call MsgBox("キャンセルしました。")
        Cancel = True
    End If
End If

End Sub

終わりに

先程のマクロを設定して社内ドメイン(Exchange含む)以外のアドレスに送信しようとすると、ポップアップでアラートを出してくれます。
これで気づかぬタイミングで社外に誤送信する事は減らせそうです。