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

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