2017年12月
          1 2
3 4 5 6 7 8 9
10 11 12 13 14 15 16
17 18 19 20 21 22 23
24 25 26 27 28 29 30
31            

« ◆Outlook VBA(メール誤送信防止のためのチェックあれこれ その1) | トップページ | ◆Outlook VBA(メール誤送信防止のためのチェックあれこれ その3) »

2011年10月29日 (土)

◆Outlook VBA(メール誤送信防止のためのチェックあれこれ その2)

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

(1)Outlookを起動したら、
(2)Alt+F11を押下してMicrosoft Basic Editorを表示します。
(3)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を呼び出すことになりますが、長くなりましたので次回とします。それではまた。

« ◆Outlook VBA(メール誤送信防止のためのチェックあれこれ その1) | トップページ | ◆Outlook VBA(メール誤送信防止のためのチェックあれこれ その3) »

パソコン・インターネット」カテゴリの記事

コメント

すみません、outlookのVBAは使った事がないのですが、このページの通りにコピーペーストしても動かないようなんですが?

petro さん
こんばんは、平陽凛です。
その3まで実装すれば動作すると思います。

平陽凛さん
こんにちは
outlook2010で、コードをお試しさせて頂きました、無事に作動していて大変素晴らしい機能だなと感じおりました。が、outlook2010を閉じる時、間違えてVBを保存しないと押してしまいました。再度Outlookを立ち上げたら、機能が動かなくなり、そしてユーザーフォームもオブジェクト名「U1」で作れなくなりました→「パス名が無効です」とエラーが出ます。私もVBに関して0な人間なんですが、どうしたらいいのでしょう?

Dさん、こんにちは
試す方法はいくつかありますが、
まずは、VbaProject.OTMを削除してから、
一からソースを張り付けなおすということを
試してみてはいかがでしょうか。
VbaProject.OTMの場所は、OSによって
違いますが、Window7、8は以下に存在します。
エクスプローラーのオプションで「隠しファイルを表示」に設定しておく必要があります。

C:\Users\[ユーザ名]\AppData\Roaming\Microsoft\Outlook

新規メール作成または返信時に自動的に挨拶文、署名、よく書かれるメール本文などは一発で簡単にテンプレートから挿入できる方法があります。

http://superdbtool.com/blog/archives/992

コメントを書く

(ウェブ上には掲載しません)

« ◆Outlook VBA(メール誤送信防止のためのチェックあれこれ その1) | トップページ | ◆Outlook VBA(メール誤送信防止のためのチェックあれこれ その3) »