プログラミング

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

-プログラミング
-

この記事タイトルとURLをコピー

Windowsユーザの方は標準のOutlookをメーラとして使う機会も多いと思います。

GmailであればChromeのプラグインでメール送信確認事も簡単にできます。

Outlookでも誤送信防止用のポップアップをOutlookで使えるようにマクロを使って誤送信防止確認ポップアップを実装したので、実装方法を共有します。

環境

今回説明で使用している環境は以下となります。

違うバージョンでも応用できると思うので試してみてください。

  • Windows 11 Home
  • Outlook (Officeアプリ)

Outlook用誤送信防止（送信確認ポップ）の実装手順

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

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

  • ファイルをクリック
  • オプションをクリック
  • リボンのユーザ設定を選択して、右のボックスの開発にチェックを付け、OKをクリックする。
  • リボンに開発が追加されていればOKです。追加されていない場合はオプションでチェックが付いているか確認してください。

2.Outlookのに誤送信防止（送信確認ポップ）マクロを追加する

次に誤送信防止（送信確認ポップ）マクロを実装します。

  • リボンの開発からVisual Basicをクリックします。
  • マクロが開くので、左のボックスからThisOutlookSessionをダブルクリックして開きます。
  • 描きコードをコピペして保存します。メッセージなどは任意に変更してください。関数名のApplication_ItemSendは変更しないでください。

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
    
    
    ' メールの件名の取得
    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

動作確認

最後に動作確認を行います。

  • 新規メールを作成して、送信ボタンをクリックします。
  • 確認用のポップアップが表示されればOKです。はいをクリックしないとメールの送信がされません。

以上で、実装完了です。

結構簡単なので、是非試してみてください！

補足:メール本文をポップアップに追加する場合


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
    Dim body As String
    
    
    ' メールの件名の取得
    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
    
    'メール本文取得
    body = Item.body
    
    ' ポップアップメッセージ作成
    popMessage = "メール件名:" & vbCrLf & subject & vbCrLf & vbCrLf & "宛先:" & address & vbCrLf & "本文:" & body & vbCrLf & "添付ファイル:" & 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

QA回答：ポップアップを表示する差出人を指定する

差出人が
A
B
C
とあって、Aだけポップアップを出したい場合の対応

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
    
    
    ' メールの件名の取得
    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 & "メールを送信してもよろしいですか?"
' 差出人がAの場合のみポップアップを表示    
If Item.SendUsingAccount = "A" Then
  If MsgBox(popMessage, vbExclamation + vbYesNo + vbDefaultButton2) <> vbYes Then
    Cancel = True
  End If
End If
On Error GoTo 0
    Exit Sub
Exception:
    MsgBox CStr(Err.Number) & ":" & Err.Description, vbOKOnly + vbCritical
    Cancel = True
    Exit Sub
End Sub

送信者の名前を取得してポップアップを出したい送信者の場合は表示するみたいな方法でいける気がします。
If MsgBox(popMessage, vbExclamation + vbYesNo + vbDefaultButton2) <> vbYes Then
Cancel = True
End

を
If Item.SendUsingAccount = "A" Then
If MsgBox(popMessage, vbExclamation + vbYesNo + vbDefaultButton2) <> vbYes Then
Cancel = True
End If
End If

のように書き換える。
Aの部分に送信者の名前を入れる感じです。（メールアドレスではなく名前です）

特定の送信元のみポップアップを表示V2(20241004)

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
    Dim frm As String
    
    
    
    ' ==========  ①利用者による設定  ==========
    ' ここは利用者の環境に合わせて設定をしてください。
    
    ' 【 送信元の設定】
    '
    ' 送信元のメールアドレスを設定します。
    ' 例：frm = "abc@def.com"
    frm = "abc@def.com"
    
    
    ' ==========================================
    
    
    
    ' =============== 編集不要 ===============
    ' ここからは修正不要です。
    
    
    ' メールの件名の取得
    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 & "メールを送信してもよろしいですか?"
    
    ' 確認用（コメントアウトしたままでOK。動作確認する場合はコメントアウトを外す）
    ' MsgBox (Item.SenderEmailAddress) ' 送信元のメールアドレスをポップアップで表示
    ' MsgBox (Item.SendUsingAccount) ' 送信元の表示名をポップアップで表示

    ' 送信元のアドレスと①で指定したアドレスが同じ場合、ポップアップを表示
    If Item.SenderEmailAddress = frm Then
      If MsgBox(popMessage, vbExclamation + vbYesNo + vbDefaultButton2) <> vbYes Then
        Cancel = True
      End If
    End If
    
    ' =============== 編集不要 ===============


On Error GoTo 0
    Exit Sub

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

End Sub

送信先に特定文字を含む場合（ver 2024/10/20）

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
    Dim frm As String
    
    
    
    ' ==========  ①利用者による設定  ==========
    ' ここは利用者の環境に合わせて設定をしてください。
    
    ' 【 送信元の設定】
    '
    ' 送信元のメールアドレスを設定します。
    ' 例：frm = "abc@def.com"
    frm = "abc@def.com"
    
    
    ' ==========================================
    
    
    
    ' =============== 編集不要 ===============
    ' ここからは修正不要です。
    
    
    ' メールの件名の取得
    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 & "メールを送信してもよろしいですか?"
    
    ' 確認用（コメントアウトしたままでOK。動作確認する場合はコメントアウトを外す）
    ' MsgBox (Item.SenderEmailAddress) ' 送信元のメールアドレスをポップアップで表示
    ' MsgBox (Item.SendUsingAccount) ' 送信元の表示名をポップアップで表示

    ' 送信元のアドレスと①で指定したアドレスが同じ場合、ポップアップを表示
    'If Item.SenderEmailAddress = frm Then
    '  If MsgBox(popMessage, vbExclamation + vbYesNo + vbDefaultButton2) <> vbYes Then
    '    Cancel = True
    '  End If
    'End If
    
    '送信先に「山田」含む場合ポップアップを表示
    If address Like "*山田*" Then
      If MsgBox(popMessage, vbExclamation + vbYesNo + vbDefaultButton2) <> vbYes Then
        Cancel = True
      End If
    End If
    
    
    
    ' =============== 編集不要 ===============


On Error GoTo 0
    Exit Sub

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

End Sub
この記事タイトルとURLをコピー

-プログラミング
-