Outlook誤送信防止！マクロ設定で安心送信

はじめに

Outlookのマクロ機能を使って送信前チェックができるようにしましょう！

マクロはExcelだけではありません。Outlookでも使えます。

今回はこれを使って誤送信防止対策を紹介します！

この記事を書いた人

またココナラもやっているので直接会話する場合はこちらから連絡ください！

モリフミブログの記事について解説します ブログで伝えきれなかった細かい話はこちらから。

モリフミのココナラページ

さぁそれではよろしくお願いします！

Microsoft officeのマクロ機能

マクロで作業効率化！というのはエクセルで目にする耳にすることがほとんどではないでしょうか。

Outlookにもあります。PowerPointにもWordにもあります。

Outlookでのマクロ起動手順

手順1．Outlookのアプリを起動する
手順2．Alt キー + F11キー(マクロの画面を開くショートカットキー)を押下する

すると・・

この画面でマクロのコードを入力していきます。

メールの誤送信防止機能とは

まずは宛先を複数名入れて、適当な題名と適当な本文を入れ送信ボタンを押下します。

特に何も設定していなければこのままメールが送信されて、メール作成ウィンドウが閉じます。

ただし、今回紹介するマクロを設定しておけば、宛先に含まれたアドレスを箇条書きに並べて表示し、送信する/しないの最終確認を促すポップアップが表示されます。

【誤送信防止マクロの機能概要】
・「はい」を押下すればメールは送信される
・「いいえ」を押下するとメールは送信されず、メール作成中の画面に戻る

【おまけ】送信忘れ防止マクロ

職場によってはplay back mailという機能を導入しているところもあります。
(何のことかという方はここは読み飛ばして下さい。)

これは特定のアドレス(よくあるのは自社ドメイン以外)にメールを送信した場合は、playbackmailにアクセスして送信ボタンを押すことではじめてメールが送信されるというものです。
(自社ドメイン以外の場合は3分後に自動送信される、などなど。設定は様々。)

これ自体が誤送信防止の機能ではあるのですが、playbackmailのシステム上の送信忘れにより他社の人にメールを送り損ねるというケースもなきにしもあらずです。

これを防止するために、自社ドメイン外のアドレスが含まれている場合に先ほどの「はい」を押下した後に以下のポップアップを表示する機能も追加しています。

「はい」を押下すると上記のplaybackmailのログイン画面に自動的に遷移するので、メール送信後すぐにシステム上で送信をすることができます。

こちらについても今回合わせて紹介します。

誤送信防止マクロの設定方法（コードの紹介）

設定手順

手順1．outlookを立ち上げる
手順2．Alt + F11を押下してマクロの入力画面を立ち上げる
手順3．This Outlook Sessionを選択する

手順4．マクロを入力する箇所(上記の「ここに入力。」の箇所)を選択する
手順5．以下のマクロのコードを貼り付ける

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

On Error GoTo Exception

Dim maxCnt As Integer
Dim strCC As String
Dim strBody As String
maxCnt = 0
strCC = vbCrLf
strBody = Item.Body

Dim objRec As Recipient
For Each objRec In Item.Recipients

'★3つの中から選択
'strCC = strCC & "・" & objRec.Name & " " & objRec.Address & vbCrLf　 '①名前+アドレス
'strCC = strCC & "・" & objRec.Address & vbCrLf   '②アドレスだけ
strCC = strCC & "・" & objRec.Name & vbCrLf   '③名前だけ

maxCnt = maxCnt + 1
'★表示件数の最大数調整
    If maxCnt >= 20 Then Exit For
Next
    
Dim strMsg As String

'★2つの中から選択
strMsg = "件名：" & Item.Subject & vbCrLf & strCC & vbCrLf & "上記の宛先に、メールを送信してもよろしいですか?"  '①メッセージ下に表示
'strMsg = "件名：" & Item.Subject & vbCrLf & vbCrLf & "下記の宛先にメールを送信してもよろしいですか?" & vbCrLf & strCC　’②メッセージ上に表示

If MsgBox(strMsg, vbInformation + vbYesNo + vbDefaultButton2) <> vbYes Then
Cancel = True
Exit Sub  'Noのときは終了

End If

On Error GoTo 0
Exit Sub

Exception:
MsgBox CStr(Err.Number) & ":" & Err.Description, vbOKOnly + vbCritical
Cancel = True
Exit Sub

End Sub

以下のようなイメージです。

手順6．貼り付けし終わったら、右上のｘを押下してウィンドウを閉じる

以上！

次に、マクロを有効にする設定を行います。

デフォルトはセキュリティ対策で、出どころ不明のマクロの使用を控えるためにセキュリティレベルが高くなっています。

マクロを有効にする設定方法

手順1．リボンの「ファイル」を押下した後に、「オプション」を押下する

手順2．「トラストセンター」の「トラストセンターの設定」を押下する

手順3．セキュリティレベルを上から3つ目、または4つ目に設定する

【3つ目と4つ目の違い】
3つ目：Outlook立ち上げ時に毎回マクロの使用を確認するポップアップが表示される
4つ目：Outlook立ち上げ時のポップアップが表示されない

以上！

それでは設定がうまくできているか試してみましょう。

設定がうまくできているか確認する方法

手順1．Outlookアプリを再起動(アプリを閉じて開く)する
手順2．メールを作成し、送信ボタンを押下する

【おまけ】送信忘れ防止マクロの設定方法（コードの紹介）

上記紹介したマクロのコードを貼り付ける際に、代わりに以下コードを貼り付けしてください。
誤送信防止のマクロ＋playbackmailによる送信忘れ防止マクロの複合版になります。

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

'■■■Outlookマクロ_誤送信チェック■■■

On Error GoTo Exception

Dim maxCnt As Integer
Dim strCC As String
Dim strBody As String
maxCnt = 0
strCC = vbCrLf
strBody = Item.Body


Dim objRec As Recipient
For Each objRec In Item.Recipients

'★3つの中から選択
'strCC = strCC & "・" & objRec.Name & " " & objRec.Address & vbCrLf　 '①名前+アドレス
'strCC = strCC & "・" & objRec.Address & vbCrLf   '②アドレスだけ
strCC = strCC & "・" & objRec.Name & vbCrLf   '③名前だけ

maxCnt = maxCnt + 1
'★表示件数の最大数調整
    If maxCnt >= 20 Then Exit For
Next
    
    Dim strMsg As String

    '★2つの中から選択
    strMsg = "件名：" & Item.Subject & vbCrLf & strCC & vbCrLf & "上記の宛先に、メールを送信してもよろしいですか?"  '①メッセージ下に表示
    'strMsg = "件名：" & Item.Subject & vbCrLf & vbCrLf & "下記の宛先にメールを送信してもよろしいですか?" & vbCrLf & strCC　’②メッセージ上に表示

If MsgBox(strMsg, vbInformation + vbYesNo + vbDefaultButton2) <> vbYes Then
    Cancel = True
    Exit Sub  'Noのときは終了

End If

'①---8<---

'■■■Outlookマクロ_PlayBackMail忘れ防止■■■

Const domain As String = "@yahoo.co.jp"
Dim chk As Boolean
Dim buf As Variant
Dim i As Integer
Dim ans As Integer
Dim recipent As Outlook.Recipient
Dim pa As Outlook.PropertyAccessor

Const PR_SMTP_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"

Set recipents = Item.Recipients
For Each recipent In recipents
    Set pa = recipent.PropertyAccessor
    If InStr(1, LCase(pa.GetProperty(PR_SMTP_ADDRESS)), domain, vbTextCompare) = 0 Then
        chk = True
        Exit For
    End If
Next

If chk Then
    ans = MsgBox("PlayBackMailの承認画面に遷移しますか？", vbYesNo + vbInformation, "確認")
    If ans = vbYes Then

        Shell "EXPLORER.EXE https://arinos.playbackmail.com/webPrj/maillogin"  'プレイバックのサイトに遷移
    End If
        
End If

'①---8<---

On Error GoTo 0
Exit Sub

Exception:
MsgBox CStr(Err.Number) & ":" & Err.Description, vbOKOnly + vbCritical
Cancel = True
Exit Sub

End Sub

【要注意！】
上記を貼り付けする際に、「@yahoo.co.jp」の部分を指定のドメインに変更する
(上記だとヤフーメールのドメイン以外にメールを送付した場合にplaybackmailのログイン画面に遷移しちゃいます。)

さいごに

VBAを読める方は上記のコードで箇条書きで表示するアドレスを「名前＋アドレス」にするのか、「アドレス」だけにするのか、「名前」だけにするのかや、箇条書きで表示する件数などをカスタムできるようになっています。

使いやすいようにコードを書き換えてください。

このワンクッションを煩わしいと感じる方もいるかもしれませんが、慣れてしまえば逆にこの最終確認ポップアップがないと不安になるくらいです。

意外とメール送信前のこのワンクッションでCCの漏れや、本文の書きっぷりの不親切さに気づくことがあります。

おすすめなので是非一度試してみてください！

オンライン説明の紹介

なかなかに複雑な内容でしたのでもし口頭で設定方法や使い方を知りたいという方がいましたらココナラから直接会話すること可能です。