Outlookの宛先確認ツールを作成

概要

簡易版ですが、OutlookのClient版において、送信ボタンを押下した際に動作する宛先確認ツールを作ってみました。
メール送信ボタン押下時に、To、CC、Bccに設定した方をポップアップで表示されることと、
予定表の送信ボタン押下時に、必須出席者と任意出席者に設定した方がポップアップで表示され、
送信前の宛先の最終確認が出来るようになります。

確認済み動作環境

Outlook Office16（Outlook Client版）

Outlookへの反映手順

1. Outlookを開く
2. 上部のファイル～ヘルプメニューのどれか（どれでもOK）
3. 右クリックして、リボンのユーザー設定をクリック
4. メインタブの開発にチェックしてOKボタンを押す
5. 開発タブ　→　Visual Basicをクリック
6. プロジェクトナビゲーターでThisOutlookSessionを開く
   　　 　Project
   　　　 　⇒Microsoft Outlook Objects
   　　　 　　⇒ThisOutlookSession
   
7. ThisOutlookSessionに下記ソースコードを貼り付け、上書き保存する
8. Outlookを再起動する
9. 「マクロを有効にする」ボタンを押下する

ソースコード

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
On Error Resume Next

Dim mailTo As String
Dim mailCc As String
Dim mailBCC As String
Dim i As Integer
Dim rtbl() As Variant
Dim otbl() As Variant
Dim r As Integer
Dim o As Integer
Dim msg As String
Dim objMail As Object
Dim objReItem As Outlook.MailItem

If TypeName(Item) <> "MeetingItem" Then
    mailTo = Item.To 'To(宛先)アドレスを定義
    mailCc = Item.CC 'Ccアドレスを定義
    mailBCC = Item.BCC 'Bccアドレスを定義
    Dim alertMsg As String '警告メッセージ


    'To、Cc、Bccを取得し、それぞれ";"で区切り改行する
    mailTo = Replace(mailTo, ";", vbCrLf)
    mailCc = Replace(mailCc, ";", vbCrLf)
    mailBCC = Replace(mailBCC, ";", vbCrLf)

    alertMsg = "To: " & vbCrLf & mailTo & vbCrLf & vbCrLf & _
               "Cc: " & vbCrLf & mailCc & vbCrLf & vbCrLf & _
               "Bcc: " & vbCrLf & mailBCC & vbCrLf & vbCrLf & _
               "上記宛先へメールを送信します。よろしいですか？"

    If MsgBox(alertMsg, vbYesNo + vbExclamation + vbDefaultButton2) <> vbYes Then
        Cancel = True
    End If
    
Else
    r = -1
    o = -1
        
    With Item
        For i = 1 To .Recipients.Count
            If .Recipients(i).Type = olRequired Then
                r = r + 1
                ReDim Preserve rtbl(r)
                rtbl(r) = .Recipients(i)
            ElseIf .Recipients(i).Type = olOptional Then
                o = o + 1
                ReDim Preserve otbl(o)
                otbl(o) = .Recipients(i)
            End If
        Next i
   End With

    msg = "必須出席者" & Chr(13)
    '必須出席者を取得
    For i = 0 To r
        msg = msg & rtbl(i) & Chr(13)
    Next i
    
    msg = msg & Chr(13) & "任意出席者" & Chr(13)
    o = -1
    o = UBound(otbl)
    If o = -1 Then
        msg = msg & "なし"
    Else
        '任意出席者を取得
        For i = 0 To o
            msg = msg & otbl(i) & Chr(13)
        Next i
    End If
            
    i = MsgBox(msg & Chr(13) & Chr(13) & "送信しますか？", vbYesNo + vbQuestion, "確認")
    If i = vbNo Then
        MsgBox "中止します"
        Cancel = True
    End If
End If
End Sub

動作サンプル（メール送信）

1. To、Cc、Bcc設定後、送信ボタンを押下する
   

2. To、Cc、Bccに設定した方をポップアップで表示される
   

動作サンプル（予定表の送信）

1. 必須参加者、任意参加者設定後、送信ボタンを押下する
   

2. 必須参加者、任意参加者へ設定した方がポップアップで表示される