[ホーム] - [Windows 10 FAQ 一覧] - [メール誤送信を防ぐOutlook の10個のお勧めVBAサンプル]



作成日：2018/08/04
更新日：2018/08/07
対象：Windows 10

メール誤送信を防ぐOutlook の10個のお勧めVBAサンプル




【目次】


最近では個人情報保護やコンプライアンス厳守のため、メールの誤送信が許されない世の中になってきました。メール送信時に目視で十分に注意すればよいのですが、メールの送信数が多い場合や多忙な場合はうっかり見過ごすこともあるでしょう。そんな場合にシステム的に間違ったメールを送信しにくい仕組みを紹介します。メーラーは Outlook を想定しています。送信時に「Application_ItemSend」というイベントが発生するため、この中で送信しようとしているメールに不備がないか確認し、不備がある場合は警告したり送信をキャンセルしたります。10個のサンプルを紹介します。組織ごとにルールに従いカスタマイズして使用してください。

社外秘、極秘、秘密、個人情報、扱い注意


メールに秘密を表す文字列が含まれないかチェックします。特に社外秘のメールを社外に転送していないかチェックします。 



If InStr(Item.Body, "社外秘") + InStr(Item.Body, "極秘") + InStr(Item.Body, "秘密") + InStr(Item.Body, "個人情報") + InStr(Item.Body, "扱い注意") <> 0 Then

       ret = MsgBox("メール本文に""社外秘、極秘、秘密、個人情報、扱い注意""のいずれかの文字が見つかりました。本当に送信してよいか確認してください。送信しますか。", vbOKCancel)

        If ret = vbCancel Then

            Cancel = True

            MsgBox "送信をキャンセルしました。"

            Exit Sub

        End If

End If


様、さま、さん、殿、御中、各位


メールには通常ではあて先に敬称等が付いているはずです。うっかり呼び捨てになっていないかチェックします。 



If InStr(Item.Body, "様") + InStr(Item.Body, "さま") + InStr(Item.Body, "さん") + InStr(Item.Body, "殿") + InStr(Item.Body, "御中") + InStr(Item.Body, "各位") = 0 Then

       ret = MsgBox("メール本文に""様、さま、さん、殿、御中、各位などが付いていない""のいずれかの文字が見つかりませんでした。本当に送信してよいか確認してください。送信しますか。", vbOKCancel)

        If ret = vbCancel Then

            Cancel = True

            MsgBox "送信をキャンセルしました。"

            Exit Sub

        End If

    

End If


本文のIPアドレスチェック


組織によってはメール本文に IP アドレスを記載することを禁止している場合があります。
正規表現でIPアドレスのチェックをしています。厳密なチェックではないため漏れがある可能性があります。 



Set objRegEx = CreateObject("VBScript.RegExp")

 

objRegEx.Global = True

objRegEx.Pattern = "[^\d](([1-9]?[0-9]|1[0-9]{2}|2[0-4][0-9]|25[0-5])\.){3}([1-9]?[0-9]|1[0-9]{2}|2[0-4][0-9]|25[0-5])[^\d]"

  

Set colMatches = objRegEx.Execute(Item.Body)

  

If colMatches.Count > 0 Then

        MsgBox "おそらくメール本文にIPアドレス が含まれます。送信をキャンセルしました。"

        Cancel = True

        

        For Each strMatch In colMatches

            MsgBox strMatch.Value

        Next

        Set objRegEx = Nothing

        Exit Sub

End If

Set objRegEx = Nothing


重要度のチェック


メールの重要度をチェックします。ここで警告が表示された場合は、社内の重要なメールをうっかり社外に送信していないかなどを確認してください。 



If Item.Importance = olImportanceHigh Then

        ret = MsgBox("メールの重要度(Priority)が = 高(high)です。送信しますか。", vbOKCancel)

        If ret = vbCancel Then

            Cancel = True

            MsgBox "送信をキャンセルしました。"

            Exit Sub

        End If

End If



本文に「添付」という文字があるのに添付されていない


メール本文に「添付」という文字があるのに添付ファイルが付いていない場合は、ファイルの添付忘れの可能性があります。警告が表示されたらチェックしてください。 



If InStr(Item.Body, "添付") <> 0 And Item.Attachments.Count = 0 Then

        ret = MsgBox("本文に""添付""という文字がありますがファイルが添付されていません。送信しますか。", vbOKCancel)

        If ret = vbCancel Then

            Cancel = True

            MsgBox "送信をキャンセルしました。"

            Exit Sub

        End If

End If



zip以外の添付ファイル


拡張子が zip 以外のファイルが添付されていないかチェックします。添付ファイルは zip 暗号化を必須とし、その他の拡張子の添付ファイルの送信は許可されていない想定としています。ただし 暗号化 zipか、拡張子を偽装していなかまでは判定していません。 



For Each Att In Item.Attachments

            If Right(LCase(Att.FileName), 4) <> ".zip" Then

                MsgBox "拡張子がzip以外のファイルが添付されています。送信をキャンセルしました。"

                Cancel = True

                Exit Sub

            End If

Next



添付ファイルの個数が10個より多い


添付ファイルが10個より多い場合送信をキャンセルします。一般的に添付ファイルが10個を超えると異常と思われます。 



If Item.Attachments.Count > 10 Then

        MsgBox "添付ファイルの個数が10個を超えています。送信をキャンセルしました。"

        Cancel = True

        Exit Sub

End If



自社以外のドメイン名が含まれる


メール送信時に自社ドメイン以外に送信する場合に確認します。要するに社外メール送信のため、念のため確認しようということです。
MYMAILDOMAINに自社の変数を設定してください。 



MYMAILDOMAIN = "example.co.jp"



For Each RECVERS In Item.Recipients

        temp = RECVERS.Address

        If Right(temp, Len(temp) - InStr(temp, "@")) <> MYMAILDOMAIN Then

            ret = MsgBox("自分のメールドメイン以外の宛先が含まれます。 メールアドレス = " & temp & "  送信しますか。", vbOKCancel)

            If ret = vbCancel Then

                Cancel = True

                MsgBox "送信をキャンセルしました。"

                Exit Sub

            End If

        End If

Next



受信者が10人以上


メールの受信者が10人以上の場合に警告します。メールに問題ないか、分割したほうがよいか、メールアドレスの漏洩にならないか確認する必要があります。 



If Item.Recipients.Count >= 10 Then

        ret = MsgBox("受信者が10人以上です。本当に送信してよいか確認してください。送信しますか。", vbOKCancel)

        If ret = vbCancel Then

            Cancel = True

            MsgBox "送信をキャンセルしました。"

            Exit Sub

        End If

End If


最終確認


最終確認します。このメッセージで最終的にこのメールを送信するか確認します。 



ret = MsgBox("***** 最終確認です。メール宛先、添付ファイル、件名など問題ありませんか。 *****", vbOKCancel)

        If ret = vbCancel Then

            Cancel = True

            MsgBox "送信をキャンセルしました。"

            Exit Sub

End If


まとめ


以上をまとめたのが以下のサンプルコードとなります。Outlook のApplication_ItemSendイベントのオーバライトしてください。またOutlook でマクロを許可する必要もあります。

マクロを設定するのは以下の箇所です。
デフォルトでは「開発」タブは表示されないので、表示させる必要があります。
[ファイル]→[オプション]→[リボンのユーザ設定]で右側の「開発」のチェックボックスをオンに設定します。

Outlookの開発タブ表示



OutlookのApplication_ItemSendイベント



詳しい設定手順はこちら：Outlook でマクロを有効化してメール送信イベントマクロを追記する手順 



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

　   Rem ===== 社外秘、極秘、秘密、個人情報、扱い注意の文字列チェック =====

    If InStr(Item.Body, "社外秘") + InStr(Item.Body, "極秘") + InStr(Item.Body, "秘密") + InStr(Item.Body, "個人情報") + InStr(Item.Body, "扱い注意") <> 0 Then

       ret = MsgBox("メール本文に""社外秘、極秘、秘密、個人情報、扱い注意""のいずれかの文字が見つかりました。本当に送信してよいか確認してください。送信しますか。", vbOKCancel)

        If ret = vbCancel Then

            Cancel = True

            MsgBox "送信をキャンセルしました。"

            Exit Sub

        End If

    

    End If

 

    Rem ===== 様、さま、さん、殿、御中、各位などが付いていない。 =====

    If InStr(Item.Body, "様") + InStr(Item.Body, "さま") + InStr(Item.Body, "さん") + InStr(Item.Body, "殿") + InStr(Item.Body, "御中") + InStr(Item.Body, "各位") = 0 Then

       ret = MsgBox("メール本文に""様、さま、さん、殿、御中、各位などが付いていない""のいずれかの文字が見つかりませんでした。本当に送信してよいか確認してください。送信しますか。", vbOKCancel)

        If ret = vbCancel Then

            Cancel = True

            MsgBox "送信をキャンセルしました。"

            Exit Sub

        End If

    

    End If

 

    Rem ===== IPアドレスのチェック =====

    Set objRegEx = CreateObject("VBScript.RegExp")

  

    objRegEx.Global = True

    objRegEx.Pattern = "[^\d](([1-9]?[0-9]|1[0-9]{2}|2[0-4][0-9]|25[0-5])\.){3}([1-9]?[0-9]|1[0-9]{2}|2[0-4][0-9]|25[0-5])[^\d]"

  

    Set colMatches = objRegEx.Execute(Item.Body)

  

    If colMatches.Count > 0 Then

        MsgBox "おそらくメール本文にIPアドレス が含まれます。送信をキャンセルしました。"

        Cancel = True

        

        For Each strMatch In colMatches

            MsgBox strMatch.Value

        Next

        Set objRegEx = Nothing

        Exit Sub

    End If



    Set objRegEx = Nothing



    Rem ===== 重要度のチェック =====

    

    If Item.Importance = olImportanceHigh Then

        ret = MsgBox("メールの重要度(Priority)が = 高(high)です。送信しますか。", vbOKCancel)

        If ret = vbCancel Then

            Cancel = True

            MsgBox "送信をキャンセルしました。"

            Exit Sub

        End If

    End If

    

    Rem ===== 本文に「添付」という文字があるのに添付されていない =====



    If InStr(Item.Body, "添付") <> 0 And Item.Attachments.Count = 0 Then

        ret = MsgBox("本文に""添付""という文字がありますがファイルが添付されていません。送信しますか。", vbOKCancel)

        If ret = vbCancel Then

            Cancel = True

            MsgBox "送信をキャンセルしました。"

            Exit Sub

        End If



    End If



    Rem ===== zip以外の添付ファイルありを検索 =====

    Rem ===== 暗号化zipか、拡張子を偽装していなかまでは判定してない =====

    For Each Att In Item.Attachments

            If Right(LCase(Att.FileName), 4) <> ".zip" Then

                MsgBox "拡張子がzip以外のファイルが添付されています。送信をキャンセルしました。"

                Cancel = True

                Exit Sub

            End If

    Next

    

    Rem ===== 添付ファイルの個数が10個以上 =====

    If Item.Attachments.Count > 10 Then

        MsgBox "添付ファイルの個数が10個を超えています。送信をキャンセルしました。"

        Cancel = True

        Exit Sub

    End If

    

    Rem ===== 自社以外のドメイン名が含まれる =====

    MYMAILDOMAIN = "example.co.jp"



    For Each RECVERS In Item.Recipients

        temp = RECVERS.Address

        If Right(temp, Len(temp) - InStr(temp, "@")) <> MYMAILDOMAIN Then

            ret = MsgBox("自分のメールドメイン以外の宛先が含まれます。 メールアドレス = " & temp & "  送信しますか。", vbOKCancel)

            If ret = vbCancel Then

                Cancel = True

                MsgBox "送信をキャンセルしました。"

                Exit Sub

            End If

        End If

    Next

    

    Rem ===== 受信者が10人以上 =====

    If Item.Recipients.Count >= 10 Then

        ret = MsgBox("受信者が10人以上です。本当に送信してよいか確認してください。送信しますか。", vbOKCancel)

        If ret = vbCancel Then

            Cancel = True

            MsgBox "送信をキャンセルしました。"

            Exit Sub

        End If

    End If

    

    Rem ===== 最終確認 =====

    ret = MsgBox("***** 最終確認です。メール宛先、添付ファイル、件名など問題ありませんか。 *****", vbOKCancel)

        If ret = vbCancel Then

            Cancel = True

            MsgBox "送信をキャンセルしました。"

            Exit Sub

        End If

End Sub





(ご注意) 本サイト内の内容を使用して発生したいかなる時間的損害、金銭的損害あるいはいかなる損害に対して、いかなる人物も一切の責任を負いません。あくまでも個人の判断で使用してください。 本ページは独自に調査をしたアンオフィシャル(非公式)な内容です。内容に誤りがある可能性や仕様変更により内容が不正確になる可能性があります。 本サイト内掲載されている情報は、著作権法により保護されています。いかなる場合でも権利者の許可なくコピー、配布することはできません。 このページはリンクフリーです。(このページへの直接リンクも可能です。)


Copyright(c) TOOLJP.COM 1999-2024

[Windows 10 FAQ 一覧に戻る]