好きなものあれこれ

前回からの続きです。メール誤送信を防ぐために作成した４つの機能について、プログラムを説明していきます。今回はThisOutlookSessionです。

（１）Outlookを起動したら、
（２）Alt+F11を押下してMicrosoft Basic Editorを表示します。
（３）ThisOutlookSessionモジュールに以下の内容をコピペします。

Private Sub Application_Itemsend(ByVal Item As Object, Cancel As Boolean)
    Dim lSubject As String
    Dim lBody As String
    Const cMongon As String = "添付｜別添｜別紙"    '本文と件名をチェックしたい文言を｜で区切って指定する
    Const cCheck As String = "xlsx｜xlsm"           '添付ファイルの拡張子をチェックしたい拡張子を｜で区切って小文字で指定する
   
    lSubject = Item.Subject '件名
    lBody = Item.Body '本文
   
    '件名チェック
    If Trim(lSubject) = "" Then
        If vbNo = MsgBox("件名が未入力です。本当に送信しますか？", vbYesNo + vbDefaultButton2 + vbExclamation, "件名チェック") Then
            Cancel = True
            Exit Sub
        End If
    End If
   
    '添付ファイル存在チェック
    lLoop = Split(cMongon, "｜")
    lTempFlg = False
    For i = 0 To UBound(lLoop)
        If lSubject & lBody Like "*" & lLoop(i) & "*" And Item.Attachments.Count = 0 Then
            lTempFlg = True
            lVal = lLoop(i)
            Exit For
        End If
    Next
    If lTempFlg = True Then
        If vbNo = MsgBox("本文または件名に「" & lVal & "」という文言が含まれています。" & vbCrLf & _
            "添付ファイルを忘れている可能性がありますが送信しますか？", vbYesNo + vbDefaultButton2 + vbExclamation, "添付ファイル存在チェック") Then
            Cancel = True
            Exit Sub
        End If
    End If
   
    '添付ファイル拡張子チェック
    If Item.Attachments.Count > 0 Then
        lLoop2 = Split(cCheck, "｜")
        For i = 0 To UBound(lLoop2)
            For Each oAt In Item.Attachments
                If StrConv(oAt.FileName, vbLowerCase) Like "*" & lLoop2(i) Then
                    If vbNo = MsgBox("添付ファイルの中に送信不可の拡張子（" & lLoop2(i) & "）が含まれている可能性があります。" & vbCrLf & _
                                    "本当に送信しますか？", vbYesNo + vbDefaultButton2 + vbExclamation, "添付ファイルチェック") Then
                        Cancel = True
                        Set oAt = Nothing
                        Exit Sub
                    End If
                End If
            Next
        Next
    End If
   
   
    '宛先確認
    gTitle = Item.Subject
    Set gAddress = Item.Recipients
    Set gTempFile = Item.Attachments
   
    Call m_SendCheck
    Cancel = SendFlg
   
End Sub

解説ですが、Application_Itemsendは送信ボタンを押下したときに発生するイベントです。引数のItemは送信しようとしているメールの情報が入っているオブジェクト型の変数です。引数のCancelはプログラムの中でTrueを設定すれば送信中止、Falseを設定すれば送信をコントロールする変数です。
プログラムの中身ですが、cMongonに添付ファイルをチェックする際に使用する文言を定義しておく変数です。他に適切な文言があれば追加してみてください。cCheckには送信前にチェックしたいファイル拡張子を追加してみてください。あとは、順番に件名未入力チェック、添付ファイル忘れチェック、拡張子チェック、宛先確認ダイアログ表示となります。

宛先確認ダイアログは標準モジュールのm_SendCheckを呼び出すことになりますが、長くなりましたので次回とします。それではまた。