Outlookで誤送信防止のVBA - Exchange Server対応
自分自身、メーラーを使ってメールを個別に送る事は大分前から少なくなっているので、メール誤送信は殆ど起こしたことが無いのですが、企業内では未だに多くのメール誤送信でトラブルが起きてる現場が多数あるみたいです。今回、VBAで送信前にチェックが出来るようにするVBAを作り、これを配布出来るようにしてみたいと思います。
ただ、昔と違い今は、あらゆるものをシステム化するのが簡単になったので、大量に個別の相手にメールを送るケースはメーラーなど使わないし、予めリストから社員番号を元に別のデータを紐つけて送るので、元データに別人のデータを入れてたなんて事がない限り、起こり得ないのですが、個別メール送信時にダブルチェックなんて無意味で無益な事に時間を費やすのは非生産的です。そもそも個別にメールを送るシーンを減らし、ダブルチェック不要とするデバッガー気質や職人芸を身に着けないと、結局は減らす事は出来ないとは思います(つまりトレーニング無くして、誤送信を減らす事は出来ない)。
今回使用するファイル
- Outlook用VBAプロジェクトファイル(インストーラ)
今回は個人利用のOutlookではなく、企業で利用するExchange Serverでの利用を想定したものです。
メール誤送信が起きる理由
企業でメール誤送信が起きる理由は多数あります。中には論外なケースもありますが概ね以下の数点になるかと思います。
- グループ内の場合はOutlookのアドレス欄はメアドではなく表示名だけが表示されているケースが多い(同姓同名の場合区別がつきにくい)
- 日本であるにも関わらず、名前.名字@ドメインといった形式で気取ってメアド作ってるケースが多いですが、名前で呼ばない日本の文化の場合、これもまた検索時の障害になっています(メアド検索時に、yamada_taro@hogehoge.comのケースだと、yamadaで検索できますが、taro_yamadaの場合、yamadaでは出てきません)。名字.名前@ドメインで作るようにしましょう
- 漢字で検索する人が非常に多い。これが誤送信の最も招く原因。サイトウという漢字だけでいくつあると思ってるの?アドレスで検索すべし
- 素直に届いたメールにReplyせずに、新規にメール作って返信する低スキルな人が多い。メールはスレッドで親メールに紐ついてるものなので、新規に作るのはそもそもマナー違反。そして、これがまた誤送信のスキを生んでいる
- そもそもメールではなく、Teamsや専用のシステム(CRMやメール一括送信システム)を活用していない。500人に500パターンのメールを手動で送るとか正気ですか?
- 他のシステムとの連動でWEB APIを活用せず、結局人間が間に入ってメールを送ってる
- 相手にまずアクションを起こさせるような業務フローを構築していない(何でもかんでも受け手のこちらが、相手にしてあげる・・・・結果新規にメールを作るシーンを増やしてる)。フォームなどを活用して、なるべくこちらから新規アクションを起こさない体制が必要(特に未だに電話やらFAXといった低レベルデバイスが主役の所は、そういった連絡手段はグループ内では極限まで減らすべき)。
- メール送信遅延機能を活用していないケース(30秒間気がつけば送信キャンセル出来るなどのアレ)
- 今回のプラグインも含まれますが、誤送信防止でワンステップ入れるようなソリューションがありますが、事実として誤送信減っていません。理由は単純で、「人間というのは慣れる」ということです。
人間という不確定要素と個人のスキルレベルに依存する以上は、メール誤送信はどこまで行っても防げない。のであるならば、その介入シーンを極限まで無くすのがメール誤送信を防ぐ最短の手段です。今回のコードのようなものはあくまでも補助的なものに過ぎず、小手先の手段です。
※ちなみに、メールアドレス自動補完オフであったり、アカウントに顔写真付けても誤送信防止には一切貢献しないのでこういったことを「誤送信防止」と称して行ってる企業はちょっとリテラシーが低すぎますね。
ソースコード
'メール送信時にメアドをExchange Serverから取得しチェックする Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean) 'エラートラップ On Error GoTo Exception 'ToとCCを取得する Dim mailTo As String Dim mailCc As String Dim ccflg As Boolean Dim messagebox As String mailTo = Item.To mailCc = Item.CC '配列用変数 Dim toarray, ccarray 'アドレスが入ってるかどうかチェック If mailTo = "" Then MsgBox "Toにアドレスが入っていません" Cancel = True Exit Sub Else 'Toを配列に加える toarray = Split(mailTo, ";") If mailCc = "" Then ccflg = False Else ccflg = True ccarray = Split(mailCc, ";") End If End If 'アドレスの個数をカウント Dim tocnt As Variant Dim cccnt As Variant Dim tonum As Integer Dim ccnum As Integer tocnt = UBound(toarray) If ccflg = False Then Else cccnt = UBound(ccarray) End If 'Exchange Server問い合わせ用変数 Dim oRecip As Outlook.Recipient Dim oEU As Outlook.ExchangeUser Dim oEDL As Outlook.ExchangeDistributionList Dim tempAddress As String Dim tempname As String Dim temptype As Integer 'ループで調査する tonum = 0 ccnum = 0 For Each objRecipient In Item.Recipients '表示名を取得する tempname = objRecipient.Name '順次Exchange Serverに問い合わせ Set oRecip = Application.Session.CreateRecipient(tempname) oRecip.Resolve 'Excange Serverのリストにあるかどうかチェック If oRecip.Resolved Then 'Exchange Serverからメアドを取得 Select Case oRecip.AddressEntry.AddressEntryUserType Case OlAddressEntryUserType.olExchangeUserAddressEntry Set oEU = oRecip.AddressEntry.GetExchangeUser If Not (oEU Is Nothing) Then tempAddress = oEU.PrimarySmtpAddress End If Case OlAddressEntryUserType.olExchangeDistributionListAddressEntry Set oEDL = oRecip.AddressEntry.GetExchangeDistributionList If Not (oEDL Is Nothing) Then tempAddress = oEDL.PrimarySmtpAddress End If End Select Else '外部宛なのでメアドを取得 tempAddress = objRecipient.Address & " 【外部宛て】" End If '送信タイプで判定し、それぞれを配列に加える(1でTo、2でCc) temptype = objRecipient.Type If temptype = 1 Then 'toArrayを書き換える toarray(tonum) = tempname & " ≫ " & tempAddress 'カウントアップ tonum = tonum + 1 Else 'ccArrayを書き換える ccarray(ccnum) = tempname & " ≫ " & tempAddress 'カウントアップ ccnum = ccnum + 1 End If Next 'Toカウント配列からメッセージを生成する messagebox = "【To】▼ " & vbCrLf For i = 0 To tocnt messagebox = messagebox & toarray(i) & vbCrLf Next i 'Ccカウント配列からメッセージを生成する If ccflg = True Then messagebox = messagebox & Chr(13) & Chr(13) & "【Cc】▼" & vbCrLf For j = 0 To cccnt messagebox = messagebox & ccarray(j) & vbCrLf Next j End If 'アナウンスを追加 messagebox = messagebox & Chr(13) & Chr(13) & "上記の宛先に送信します。本当に大丈夫ですか??" '送信確認メッセージ If MsgBox(messagebox, vbYesNo + vbExclamation + vbDefaultButton2) <> vbYes Then Cancel = True End If Exit Sub Exception: 'エラー発生時の処理 MsgBox CStr(Err.Number) & ":" & Err.Description, vbOKOnly + vbCritical Cancel = True Exit Sub End Sub
- このコードは、ThisOutlookSessionに書く必要があります。
- また、送信時イベントの名称はApplication_ItemSendとなります。これで送信時に自動的に呼び出されます。
- 複数ToやCcが入ってることを考慮する必要があるので、それぞれSplit関数でセミコロンを区切りとして配列化しておきます。
- MS公式コードでExchange Serverに表示名を送りつけ、メールアドレスを取得します。他にも取得できそうな予感
- Exchange Serverの場合、普通にReceipents.Addressだとオカシナ文字列が取得されるので使えません。
- Exchange Serverに登録がない場合は、外部アドレスと判定し普通にReceipents.Addressでメアドを取得します。
- 配列に表示名+アドレスの塊で値を入れ込み、それを利用してメッセージを作成します。
- objRecipient.Typeにて、Toなのか?Ccなのかの判定が可能。1ならTo、2ならCcとなります。
- Cancel = Trueを使うことでキャンセルが実行された場合にコードの実行が中止されます。Exit Subだけだとメールが送信されてしまいます。
- 外部宛メアドには、外部向けの文字列を追加するようにしています。
- ただし、通常のメッセージボックスだと表示に限界があるので、場合によってはUser.Formなどを使ってやり取りが必要かもしれません(すごく面倒ですが)
図:このようなダイアログが表示されるようになります
図:書く場所と書くルールに注意
Outlook VBAを配布する
注意点
Outlook VBAでは、Excelと異なりプラグインの作成が出来ません。VSTOプラグインであれば作成し簡単に配布は出来ますが、Visual Studioを使ってC#で記述が必要になります。そこまでしてOutlookプラグインを作るほどメリットあるかなぁというのが正直な意見。大規模システムと連携するようなケースならば価値はあると思いますが。
また、プラグインが作れない以上、1つのOutlookに配布出来るものは1つに限られてしまいます。つまり別のプロジェクトを既にインストールしてる場合上書きされてしまうので、常に1個のOTM形式のファイルを持って他のプロジェクトと含めての配布が必要になります。Excelのようなxlam形式で作れて配布できるなら最高なんですけれどね。
配布方法
作成したVBAはOutlookの特定のフォルダ内にOTMという拡張子でファイルが生成されているので、これを他のユーザの同じ場所に配置すれば利用可能になります。配置場所は以下の場所になります。ファイル名は「VbaProject.OTM」という名前になります。
C:\Users\ユーザ名\AppData\Roaming\Microsoft\Outlook
図:OTMがVBAプロジェクトの実体
このファイルを元にInno Setupでインストーラを作ってみます。変更点はインストール先の1箇所だけ。
DefaultDirName={userappdata}\Microsoft\Outlook
DefaultDirNameの値の指定に、{userappdata}を指定する事で、ユーザのAppDataのRoaming以下の指定になります。後はコンパイルしてEXEを作成すれば、インストーラで全ユーザ対象にVBAコードを手間なく配布する事が可能になります。
※実際にインストールする場合は、Outlookが起動していない状態(タスクトレイにも常駐していない状態)である必要があります。起動中はインストールは出来ません。
使用するにあたって
Outlook VBAをそのまま導入しても動作しません。動作させようとすると、毎回セキュリティ通知が出るようになります。これを回避するには、以下の2パターン
- 設定からマクロのセキュリティレベルを下げる
- VBAにデジタル署名を追加して導入してもらうようにする
前者は、ファイル⇒オプション⇒セキュリティセンター⇒セキュリティセンターの設定⇒マクロの設定にあるレベルを「すべてのマクロを有効にする」にチェックをいれます。ただし、これはセキュリティレベルを下げる事になりますが、ExcelやWordと異なりOutlookはVbaProject.OTMからしかVBAが実行出来ないので、この設定でも過度に問題にはなりにくいです。
後者はVBAの作成画面にて以下の手順でデジタル署名を追加する方法です。
- Outlookの開発タブ⇒Visual Basicを開く(開発タブが表示されていない場合は設定から表示する)
- C:\Program Files\Microsoft Office\root\Office16の下にあるSELFCERT.EXEを起動する
- デジタル署名の作成が出てくるので、適当な名前を入れてOKをクリック
- VBAの作成画面に戻り、ツール⇒デジタル署名をクリック
- 選択をクリックすると、作成したデジタル証明書が出てきます。詳細で複数の証明書から選択も可能
- OKをクリックするとデジタル証明書が適用されます。
ただしこの方法はユーザごとに必要で証明書付きでVBAプロジェクトの配布が出来ません。Excel VBAと異なりこの辺が面倒ですね。
図:毎回出てくるセキュリティ通知
図:マクロのセキュリティレベル変更画面
図:デジタル署名の作成画面
関連リンク
- 【Outlook VBA】カンタンに送信前に入力した宛先を確認するメッセージを表示する
- ダブルチェックの有効性を再考する
- 無意味なダブルチェックをしていませんか?
- 「多重チェックでエラーは防げる」の誤解
- 作成したマクロを配布するには
- Deployment ms outlook macros in multiple systems with out using visual studio
- Map a Display Name to an Email Address
- Excel vba outlookのExchangeのグローバルアドレス一覧から特定の肩書から名前を検索するマクロ
- 宛先がExchangeかどうかを判別するマクロ
- OutLook VBA:マクロの配布方法
- Split関数で文字列を区切る
- Obtain the Email Address of a Recipient
- VBAでOutlookのメール送信前チェック
- VBA ループ処理で配列に要素を追加していく
- デジタル署名を追加してデータベースが信頼できることを示す
- Outlook VBAにおいてユーザーフォームをモジュールからアクティブにする方法
- 第10回.標準モジュールとフォーム間のデータ受け渡しⅡ
- Outlook VBA マクロ、はじめの一歩
- 自己署名デジタル証明書
- Outlook VBA オブジェクト まとめ
- Outlook アドイン開発入門