📪

Outlook誤送信防止をマクロで作ってみた

2022/05/07に公開

Outlook でお金かけず誤送信防止を実装したかったので、簡単にマクロで組んでみた。

1.下準備:Outlook の開発リボン(マクロ)の有効化

デフォルトだと Outlook の開発リボンが無効になっているため、マクロを追加ができない。

最初に開発リボンを有効化する。

1.メニューバーのファイルをクリック

2.オプションをクリック

3.リボンのユーザ設定を選択して、右のボックスの開発にチェックを付け、OK をクリックする。

4.リボン開発が追加されていることを確認

2.誤送信防止マクロの実装

1.リボンの開発からVisual Basicをクリック

2.左のボックスから ThisOutlookSession を開く

3.コードをコピペ
下記コードをコピペして保存する。

code
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
On Error GoTo Exception

    Dim address As String
    Dim subject As String
    Dim attachment As String
    Dim popMessage As String
    Dim objRecipient As Recipient


    ' Itemでメールの件名の取得
    subject = Item.subject

    ' Item.Recipientsで全受信者を取得し、受信者ごとの表示名とメールアドレスを格納
    address = vbCrLf
    For Each objRecipient In Item.Recipients
        address = address & objRecipient.Name & "(" & objRecipient.address & ")" & vbCrLf
    Next

    ' Item.Attachmentsで添付ファイル情報を取得し、ファイル名を格納
    attachment = vbCrLf
    For Each objAttachment In Item.Attachments
        attachment = attachment & objAttachment.FileName & vbCrLf
    Next

    ' ポップアップに表示するメッセージを作成
    popMessage = "メール件名:" & vbCrLf & subject & vbCrLf & vbCrLf & "宛先:" & address & vbCrLf & "添付ファイル:" & attachment & vbCrLf & vbCrLf & "メールを送信してもよろしいですか?"

    ’ ポップアップを表示
    If MsgBox(popMessage, vbExclamation + vbYesNo + vbDefaultButton2) <> vbYes Then
        Cancel = True
    End If

On Error GoTo 0
    Exit Sub

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

End Sub

3.動作確認

1.新規メールを作成して送信ボタンをクリック。

2.ポップアップが表示されることを確認

確認用のポップアップが表示されれば OK です。

以上で、実装完了!

GitHubで編集を提案

Discussion