[トップページへ] [Windows 10 FAQ 一覧に戻る]

対象: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-2018

[Windows 10 FAQ 一覧に戻る]