©stockimages
概要
Outlook でメール誤送信をしてしまわないか不安なときに使えるマクロです。
用途
以下の様な冷や汗をかく経験をしないように、ちょっと立ち止まって再チェックを促すマクロです。
- 名前を呼び捨てのままメール送信してしまった。
- 一応念を入れて確認のため受信するつもりだったが、間違えて書きかけメールを送信してしまった。
- 添付ファイルを付けてしまった/忘れた。
- メール本文の出だしが唐突だったり、自分しかわからない内容で相手にはわかりづらかった。
- 内部ではなく、外部向けMLも宛先に入っていた。
※ほんと、考えるだけで恐ろしい。。。((((；ﾟДﾟ))))ｶﾞｸｶﾞｸﾌﾞﾙﾌﾞﾙ
機能
(マクロが有効になっている時に)普段のメール送信ボタン押下後、実際にOutlookがメール送信する前に様々なチェックをサポートして、ユーザに再確認を促すダイアログを出現させます。
機能：メールチェック、無意識送信防止
主なチェック項目：件名、宛先（外部アドレス）、敬称、添付忘れチェック、予算やセキュリティ情報に絡む重要文言 （下図参照）
以前は忙しいと、月1回あるかないかで微妙なメールを送ることがよくありましたが、ミスするたびにこのマクロを改造したりして、そのような体験はほぼなくなってきました。仮にメール送信時マクロによって焦ってると気づいた時は、心を落ち着かせ今一度宛先、件名、本文の出だし、本文の宛先などを指差し確認しています。
［補足］マクロ登録先について
2007 はExcelオプション → 基本設定 から、2010はクイックタブのあたりを右クリックして設定画面に遷移し、リボンの設定から開発タブを表示させる設定をすると開発タブがでてきます。そこにある Visual Basic Editorから (& セキュティ許可をして）使うことができます。 毎回起動時に許可するのは面倒ですが。。
マクロソースの貼り付け場所は、開発タブの Visual Basic Editor から OutlookのThisOutlookSession にApplication_ItemSend のSub関数を貼り付けておきます。そうすると送信ボタンを押して、フォルダ格納時にマクロがOutlookにより自動で起動されます。（テストとして、試しに自分宛てに空メール等を送ってみてください）
FAQ
ダイアログが出ず、マクロが実行されてないようであれば以下の3つの直接原因が考えられます。
- セキュリティ上マクロ実行が無効になっている→マクロのセキュリティを変更する。
- マクロが読まれていない→Outlookアプリケーションを再起動して、読み込みを許可させる（ダイアログが出ると思います）。
- ThisOutlookSession に記載されておらず、送信時に実行されない→適切な場所にマクロのソースを貼り付けます。
［補足］セキュリティオプションの設定
マクロを動作させるには、Outlookのセキュリティオプションを設定しておく必要があります。 （例：Outlook 2013,2010)
↓これによって、Outlookの起動時にダイアログが表示されるようになるので、「マクロを有効にする」をクリックして起動します。
- 「ファイル」タブで「オプション」を選択
- 「セキュリティセンター」から、「セキュリティセンターの設定」ボタン
- 「マクロの設定」を選択し、「すべてのマクロに対して警告を表示する」をチェックON
その他おまけ等
その他の改造例
- 送信者が特定の時チェックする（メールボックスを複数持っている時向け）
- 宛先にMLが入っていたらチェックする
- bccに必ず自分のメールアドレスを設定させる
その他メール全般のお薦めテク
- メール全体対象の送受信ボタンは右端において、個別メールごとに行う返信や送信ボタンは左に置くようレイアウトする。→誤クリックをかなり防止します。（致命的なものは、意識して操作させるように若干使いにくくさせる）
- 新規作成などメール作成ウィンドウでをメール送信しても、直ちに送信しないよう（設定ができるのであれば）設定する。送信フォルダに格納されるだけ。 送信フォルダ格納後、メールビューウィンドウの送受信ボタンで送信する（昼休み前や帰り際に忘れずに！）。
参考
Outlookマクロ：fromアドレスと件名の確認、常にBCC | hm-lab- Outlook VBA Tips - おためしwiki
- ◆Outlook VBA（メール誤送信防止のためのチェックあれこれ その２）: 好きなものあれこれ
これもおすすめ
作業効率技の、次のページもどうぞ
Outlook
- 作業効率化！メール本文からスケジュール登録をワンクリックで行うマクロ-outlook
- メール本文の分断されたパスをワンクリックで開く！
- Outlook使う上で作業効率のためのおすすめ設定【ビジネスハック】
- 【さくっと】定期開催されるOutlookスケジュールを一覧で出力するマクロ
- Outlookでの仕事効率技５連発！
Excel
マクロソース
GitHub上でどんどん改造しちゃってください(MIT Licence)。
Git使い慣れていないとわかりづらいかもしれませんが、 CheckSendingMail プロジェクト > CheckSendingMail.txt にマクロソースは入っています。
ユーザ定義がないと RegExpのところで警告が出たら。。。
RegExp（正規表現）を表示のため使っているので以下の設定をしてください。
VBA Editor のツール(T) -> 参照設定(R) から "Microsoft VBScript Regular Expressions 5.5 ”. をチェック
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 |
Public Function warning_exit(flag As Boolean, warning As String) As Boolean If flag = True Then If MsgBox(warning, vbOKCancel + vbExclamation) = vbCancel Then Cancel = True End If End If warning_exit = Cancel End Function Function include_check_words(includeCheck As Boolean, contents As String, includewordset As String) As Boolean Dim foundflag As Boolean includewords = Split(includewordset, ",") foundflag = False For i = LBound(includewords) To UBound(includewords) If InStr(contents, includewords(i)) > 0 Then foundflag = True Exit For End If Next i include_check_words = (includeCheck = foundflag) End Function Private Sub Application_AdvancedSearchComplete(ByVal SearchObject As Search) End Sub Private Sub Application_BeforeFolderSharingDialog(ByVal FolderToShare As MAPIFolder, Cancel As Boolean) End Sub 'メール送信時にチェックするマクロ ' 機能：メールチェック、メール保存 ' 主なチェック項目：件名、宛先（外部アドレス）、敬称、添付、重要文言 ' Private Sub Application_ItemSend(ByVal item As Object, Cancel As Boolean) 'userセッティング Dim MyDomain As String Dim existExternAddress As Boolean Dim apdMsg As String Dim subContentsStr As String '一時保持 Dim cnt As Integer Dim strAddress As String Dim strSubject As String Dim contents As String 'for output Dim fileNames As String Dim message As String Dim externAdd As String 'temp Dim i As Integer Dim flag As Boolean If TypeOf item Is Outlook.MailItem Then 'MsgBox ("prop:" & item & " Mail! ") Else Exit Sub '会議の場合 End If ' 初期値 MyDomain = "jp.ec.com" '＜自社のドメインなど＞ MyDomainSecond = "n.co.jp" '＜自社のドメインなど＞ apdMsg = vbCrLf & "キャンセルを選択すると送信を中断します。" cnt = item.Attachments.Count ' 添付ファイル数 strSubject = item.Subject strBody = item.Body 'MsgBox (cnt & " " & strSubject & vbCrLf & strBody) ' メールを保存する item.Save ' 宛先なしチェック ' Outlook 2010などは 標準機能でチェックされます。 message = message & "1/7 " If item.To = "" Then message = message & "[NG]:宛先がありません！" Else message = message & "[OK]:宛先" End If ' 件名なしチェック ' Outlook 2010などは 標準機能でチェックされます。 message = message & vbCrLf & "2/7 " If strSubject = "" Then message = message & "[NG]:このメッセージには件名がありません。" Else message = message & "[OK]:件名あり" End If If InStr(strSubject, "UNCHECKED") > 0 Then message = message & "(余計な文字あり)" End If contents = strSubject & strBody ' 添付ファイルチェック message = message & vbCrLf & "3/7 " flag = False If cnt = 0 Then fileNames = "添付ファイル無し" flag = include_check_words(True, contents, "添付,圧縮,xls,ppt,doc,zip") If flag = True Then message = message & "[WARN]:添付ファイルを忘れている可能性があります。" Else message = message & "[OK]:添付忘れチェック(添付, zipなどのキーワードなし)" End If Else For i = 1 To cnt fileNames = fileNames & "添付" & i & "：" & item.Attachments.item(i).FileName & vbCrLf Next i message = message & "[OK]:添付忘れチェック(" & cnt & "件添付)" End If ' 要注意ワードチェック message = message & vbCrLf & "4/7 " flag = False flag = include_check_words(True, contents, "見積,予算,契約,厳禁,金額,内緒,内々") 'Confidential If flag = True Then message = message & "[WARN]:要注意メール!!:重要なメールではありませんか？" & vbCrLf & " 宛先や添付ファイル等を確認して下さい。" Else message = message & "[OK]:要注意ワードチェック" End If ' 敬称ワードチェック message = message & vbCrLf & "5/7 " subContentsStr = "" flag = False includewords = Split(strBody, ",") m = UBound(includewords) If mi > 10 Then mi = 10 End If For i = LBound(includewords) To mi subContentsStr = subContentsStr & includewords(i) Next flag = include_check_words(False, subContentsStr, "さん,様,殿,各位,担当者,どの") If flag = True Then message = message & "[WARN]:敬称(様、さんなど)がもれて呼び捨てにしていませんか？" Else message = message & "[OK]:敬称チェック" End If ' 社外アドレスチェック message = message & vbCrLf & "6/7 " existExternAddressName = "" existExternAddress = False myadrflag = False For i = 1 To item.Recipients.Count With item.Recipients.item(i) strAddress = .Address If Not (strAddress Like "*" & MyDomain & "*" Or _ strAddress Like "*" & MyDomainSecond & "*" _ ) Then existExternAddress = True existExternAddressName = existExternAddressName & strAddress & " " End If 'MsgBox strAddress & "," & myAddress & " | " _ '& (myAddress = strAddress) & "," & (strAddress = myAddress) If strAddress = myAddress Then myadrflag = True End If End With Next StartTime = Now If existExternAddress = True Then externAdd = "外部メールアドレス：有(" & existExternAddressName & ")" message = message & "[WARN]:外部メールアドレスが宛先にあります。" Else externAdd = "外部メールアドレス：なし" message = message & "[OK]:外部アドレスチェック" End If message = message & vbCrLf & " " If myadrflag = True Then message = message & "([OK]:my address あり)" Else message = message & "([WARN]:my address無し)" End If flag = warning_exit(True, message & vbCrLf & apdMsg) If flag = True Then Cancel = True Exit Sub End If ' 表示メッセージ message = "7/7 最終確認です。送信する前に再度宛先、件名、添付ファイル、本文の書き出し等確認してください。" & vbCrLf & _ "送信者:" & appendList(item.Session.CurrentUser.Address) & vbCrLf & _ fileNames & vbCrLf & _ externAdd & vbCrLf & vbCrLf & _ "[To]:" & appendList(item.To) & vbCrLf & _ "[CC]:" & appendList(item.CC) & vbCrLf & _ "[BCC]:" & appendList(item.BCC) & vbCrLf If MsgBox(message, vbOKCancel + vbExclamation) = vbCancel Then Cancel = True Exit Sub End If Do While DateDiff("s", StartTime, Now) < 3.7 '4秒位内なら再確認 If MsgBox("焦らず確認しましょう" & vbCrLf & message, vbOKCancel + vbExclamation) = vbCancel Then Cancel = True Exit Sub End If Loop If (Hour(Now) >= 11 And Hour(Now) <= 13) Or (Hour(Now) >= 18) Then MsgBox ("送信フォルダに格納します。" & vbCrLf & "送信確認してください。") End If End Sub ' 宛先などのアドレスを見やすくする関数 Private Function appendList(strName As String) Dim re As RegExp Dim mc As MatchCollection Set re = New RegExp re.Global = True re.Pattern = "[ ]*;[ ]*" strName = re.Replace(strName, vbCrLf) re.Pattern = "/.*cn=([^/]+)" appendList = re.Replace(strName, "$1") End Function |
関連ページリンク
45,479 views.
【仕事で残念な人にならないために】Outlookメール誤送信チェックマクロ【冷汗防止】 – https://t.co/R0796d9oBa
@garapom これどうだろ（まさにVB
https://t.co/OOhNTUkQZm
初めまして。
【仕事で残念な人にならないために】Outlookメール誤送信チェックマクロ【冷汗防止】のマクロソースを利用させていただきました。
ありがとうございます。
とても便利で、良いものを見つけたと喜んでいるのですが、
メールを送信した後、「ユーザー定義型は定義されていません。」というコンパイルエラーが出てしまいます。
参照しているライブラリが足りないのか、とか色々やっているのですが、解決しません。
解決方法などありましたら、お聞かせいただけると嬉しいです。
OS：Windows8 Outlook2013を使っています。
よろしくお願いいたします。
ありがとうございます。
そのエラーは直接的には、未定義なものがあるようです。
もし、 appendList 関数のところならば
RegExp（正規表現）を表示のため使っているので以下の設定をしてください。
VBA Editor の ツール(T) -> 参照設定(R) から “Microsoft VBScript Regular Expressions 5.5 ”. をチェック
対処方法ありがとうございます。
お陰さまで解決しました。
便利ですので、同僚にも勧めているところです。
よさそうなものができた時は、共有したかったので、なおのこと
喜んでもらえてなりよりです。:b