一定時間内に特定のキーワードを含むメールを複数受信したらアラームを表示するマクロ


コメントにて以下のご要望をいただきました。


管理人様

はじめまして。コメント失礼致します。
https://outlooklab.wordpress.com/2018/02/10/
以前上記で記載いただいたマクロに関しまして、条件を「一定時間内にメール本文に同じ文言が含まれるメールを複数受信したらポップアップ(通知)等をあげる」という条件のマクロの構文を伺ってもよろしいでしょうか?


マクロでポップアップ表示を行った場合、そのポップアップを閉じるまでは他のマクロが実行できない状態となってしまいます。
ポップアップ以外の通知方法としては Outlook のアラームを使用する方法がありますので、一定期間内に特定のキーワードを含むメールを指定数受信したら、最後に受信したメールにフラグを付けてアラームを表示するようなマクロにしてみました。

' ここをトリプルクリックでマクロ全体を選択できます。

Dim g_strLastReceived As String
'
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
     Dim objItem As Object ' MailItem
     '
     Set objItem = Session.GetItemFromID(EntryIDCollection)
     '
     If objItem.MessageClass = "IPM.Note" Then
         FindAndNotice objItem
     End If
End Sub
'
Private Sub FindAndNotice(ByVal objItem As MailItem)
     ' 監視するキーワード
     Const MONITOR_KEYWORD = "test"
     ' 通知するメール数の閾値
     Const MAX_MAILS = 10
     ' 監視する時間 (分単位)
     Const INTERVAL_MIN = 10
     ' 通知メールの本文
     Const ALERT_FLAG_NAME = "メールを " & INTERVAL_MIN & _
         " 分以内に " & MAX_MAILS & " 件受信しました。 """
     Dim arrDate() As String
     Dim dtStart As Date
     Dim strStart As String
     Dim i As Integer
     ' メールがキーワードを含まなければ終了
     If InStr(objItem.Body, MONITOR_KEYWORD) = 0 Then
         Exit Sub
     End If
     ' 受信日時の配列を生成
     arrDate = Split(g_strLastReceived, ";")
     If UBound(arrDate) < 0 Then
         g_strLastReceived = objItem.ReceivedTime
     ElseIf UBound(arrDate) < MAX_MAILS - 1 Then
         g_strLastReceived = g_strLastReceived & ";" & objItem.ReceivedTime
     Else
         g_strLastReceived = ""
         ' 監視の開始時間を算出
         dtStart = DateAdd("n", -INTERVAL_MIN, Now)
         If CDate(arrDate(0)) >= dtStart Then
             ' 配列の先頭が監視の開始時間よりも後ならフラグを設定
             objItem.MarkAsTask olMarkToday
             objItem.FlagRequest = ALERT_FLAG_NAME
             ' フラグのアラームを現在時刻にして直ちにアラーム表示
             objItem.ReminderTime = Now
             objItem.TaskDueDate = Now
             objItem.ReminderSet = True
             objItem.Save
         Else
             ' 監視期間中に一定量受信していなければ、受信日時を追加
             For i = 1 To UBound(arrDate)
                 g_strLastReceived = g_strLastReceived & arrDate(i) & ";"
             Next
             g_strLastReceived = g_strLastReceived & objItem.ReceivedTime
         End If
     End If
End Sub

マクロの登録方法やメニューへの追加について

広告

コメントを残す

以下に詳細を記入するか、アイコンをクリックしてログインしてください。

WordPress.com ロゴ

WordPress.com アカウントを使ってコメントしています。 ログアウト /  変更 )

Google フォト

Google アカウントを使ってコメントしています。 ログアウト /  変更 )

Twitter 画像

Twitter アカウントを使ってコメントしています。 ログアウト /  変更 )

Facebook の写真

Facebook アカウントを使ってコメントしています。 ログアウト /  変更 )

%s と連携中