Inbox Rule to Send Alert When Rate of Emails Increases - vba

Question

I receive hundreds of automated alerts everyday (for things like CPU/Memory spikes, SQL Blocks). However, usually, there's nothing that I can/want to do when these alerts come in; I only care when there is a surge of alerts, because that's abnormal. I do at least have them going to separate folders, but that's still distracting, because I have to always be somewhat mindful of that unread email number.
Is there some way to alert me when I get, say, more than X number of emails from sendername within N minutes?
Using Outlook, Office 365
I tried looking for Outlook add-ins, but it's a difficult question to describe to Google. I know a tiny bit of VBA, but not enough to get me started on this.

Answer 1

Basically, you have to run a timer to periodically run a scanner for the number of emails arrived in your inbox. In the event handler fired by the timer (usually called Tick) you can use the Find/FindNext or Restrict methods of the Items class.
The simplest and fastest way is to create a VBA macro. See Getting started with VBA in Office and Using Visual Basic for Applications in Outlook articles to get started quickly.
The following articles can help you with coding the required algorithm on top of described methods for looking Outlook items:
How To: Use Find and FindNext methods to retrieve Outlook mail items from a folder (C#, VB.NET)
How To: Use Restrict method to retrieve Outlook mail items from a folder
Advanced search in Outlook programmatically: C#, VB.NET
To run a timer periodically you can use the SetTimer function.
See Outlook VBA - Run a code every half an hour for the sample code.
Public Declare Function SetTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long) As Long
Public TimerID As Long, TimerSeconds As Single
Dim Counter As Long
' Start Timer
Sub StartTimer()
' Set the timer for 1 second
TimerSeconds = 1
TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf TimerProc)
End Sub
' End Timer
Sub EndTimer()
On Error Resume Next
KillTimer 0&, TimerID
End Sub
Sub TimerProc(ByVal HWnd As Long, ByVal uMsg As Long, ByVal nIDEvent As Long, ByVal dwTimer As Long)
Debug.Print Now
' call your code here
End Sub

Answer 2

I assume from your question that you were hoping someone had already developed a solution to your problem. Perhaps they have but I think it is unlikely that they would post that solution for others to find. I think you will have to develop your own solution. The approach I have developed is very different from Eugene’s. Between us, we offer some interesting ideas for you to select from.
I do not believe the VBA needed is particularly advanced. You may already know enough, particularly with two answers to study. If not, I would start with Excel VBA. I have failed to find an Outlook VBA tutorial I like but have seen of several Excel VBA tutorials that look good. I prefer books. I visited a good library, looked at several Excel VBA Primers and borrowed the most promising to try at home.
You will also need to understand the Outlook Object model. An Excel VBA tutorial will teach you about workbooks, worksheets, ranges, cells and so. For Outlook, you need to understand stores, folders, mail items, calendar items and so on. As I said, I have failed to find an Outlook VBA tutorial I like and I do not like the high recommended book I bought. I learnt my Outlook VBA by experimentation. Eugene has included explanations in his answer and I will include explanations in mine. Hopefully between us we will give you enough of a start. You might be lucky to find a post that explains topics A, B and C together. I find it better to look up topics individually and then write experimental macros that combine them. If you fail with an experimental macro, post it here with an explanation of what you are trying to achieve and what is going wrong; you will almost certainly get help.
To emulate your problem, I picked four suppliers that email me often enough to develop and test my monitoring code. You say you use rules to move these emails to separate folders which seems a good idea to me. Rules offer a number of classifications by which an email can be selected and I gather you can select these emails from your input stream. Rules also offer a number processing options. You have used “Move to a folder”. Another is “Run a script”. A script in this context is an Outlook VBA macro with a specific structure. I was confident, I could create a macro to perform the monitoring you require. However, there is a problem: Outlook runs the macro before it moves the email to the new folder. This is not a big problem but it means you cannot use the rule to move the email. You must get the macro to move the email which is not difficult.
I created a rule for each supplier for which the summary was:
Apply this rule after the message arrives
from Xxxxx
and on this computer only
run Project1.Yyyyy
and stop processing more rules
“Xxxxx” is the name of a supplier and “Yyyyy” is the name of the macro that will process the email. I am a home user so “and on this computer only” has no effect for me but it might for you. Without “and stop processing more rules” you will get messages saying the email cannot be found because Rule X moves the email then Rule Y cannot find it in Inbox.
Macro Yyyyy is of the form:
Public Sub Yyyyy(ByRef itm As MailItem)
Call CountAndWarn("test folders\Xxxxx", itm, 2, 180, 3, 600)
End Sub
The names of the macros are not important. Clearly if a rule says run macro Yyyyy there must be a macro Yyyyy but the value of Yyyyy is not important. I named my macros after Outlook’s names for the suppliers but you will presumably have to name them after the type of email.
The format of the first line, Public Sub Yyyyy(ByRef itm As MailItem) is more or less fixed for a macro to be run by a rule. The first parameter must be the MailItem. There are further optional parameters for which I have never had a use.
CountAndWarn is a macro I have written to process all these emails. It has at least four parameters but can have six or eight or more if that would be helpful for a particularly type of email.
"test folders\Xxxxx" identifies the folder to which the email is to be moved.
If you look at your Outlook folder pane, you will see at least one name against the left edge. Under that, but indented, will be system folders such as Inbox, Deleted Items, Sent Items and Outbox. Under any of the system folders, you can have private subfolders. You can also have private folders, at the same level as the system folders, any of which can have sub-folders and sub-sub-folders to any depth. The name against the left edge identifies a store. A store is a file in which Outlook stores emails, appointments, tasks and so on. You will have at least one store into which your emails are loaded. You may also have shared stores which can be public to your entire organisation or private to your team or department. You can have at many private stores as you wish.
On my system, I have one store per email address (I have three) plus several private stores. In "test folders\Xxxxx", “test folders” is the name of a private store I use for experimentation. Within “test folders” I have created four folders, one per supplier I am monitoring. Within each of these folders, I have a sub-folder “Old” which I will explain later. So within my folder pane, I have a section that looks like:
test folders
Xxxxx
Old
Wwwww
Old
Vvvvv
Old
Uuuuu
Old
As I have said, "test folders\Xxxxx" identifies a folder. The format of this string is “StoreName\FolderName\SubFolderName\SubSubFolderName …”. I have placed my folders in an experimental store; you have probably placed your folders in your main store. You can place them anywhere you have write permission. This string must specify the entire name of the folder starting with the store name. Your names might be: “YourMainStore\Inbox\CPU Spikes” and “YourMainStore\Inbox\SQL Blocks”.
Returning to Call CountAndWarn("test folders\Xxxxx", itm, 2, 180, 3, 600).
The second parameter, itm, passes the email to CountAndWarn so it can move the email to the specified folder.
The remaining parameters are one or more pairs of integers of which the first is a count of emails and the second is a number of minutes. My parameter list means I wished to be warned if:
2 emails have arrived in the last 180 minutes from supplier Xxxxx
3 emails have arrived in the last 600 minutes from supplier Xxxxx
I do not receive many of these emails per day so my counts are low and my periods are long. Your counts will be much higher and your periods much shorter.
I do not know if you might wish to monitor different periods but there was little extra code to allow for several periods so I included it. You must have at least one count and one period but you can have as many extra pairs as you wish. If you have multiple periods, they must be in ascending sequence with the longest period last.
The macro CountAndWarn does the following:
Locate the named destination folder, for example, "test folders\Xxxxx".
Locate the corresponding “old” folder, for example, "test folders\Xxxxx\Old".
Move the email to the destination folder
Count the emails in each period. If an email is older than the end time of the last period, move it to the “old” folder so it is not checked every time a new email arrives.
If any of the counts exceeds the maximum for its period, a message box like the following is displayed.
These macros could be ideal if all you want is an instant warning of every spike during the day. Deficiencies include:
While a spike continues, you will be warned about each new email.
You will not be warned about a spike in the middle of the night.
The first deficiency could not be fixed without keeping records. For example, macro CountAndWarn counts the emails in a folder and reports a high count. It does not record that it warned you about the current spike ten seconds ago when the last email arrived. Keeping records in a text file would not be difficult but you will need to think about what records will help you analyse the spikes.
Spikes in the middle of the night will require analysis of the old emails. The current macro just counts emails in the last X minutes. Reviewing last night’s emails will involve counting the emails in every X minute period since close of play yesterday. That analysis probably will not require any obscure VBA but will require some careful design.
Come back with questions, if you do not understand anything in the following macros:
Option Explicit
Public Sub Argos(ByRef itm As MailItem)
Call CountAndWarn("test folders\Argos", itm, 2, 180, 3, 600)
End Sub
Public Sub Guardian(ByRef itm As MailItem)
Call CountAndWarn("test folders\Guardian", itm, 1, 600, 2, 1200, 3, 1800)
End Sub
Public Sub Amazon(ByRef itm As MailItem)
Call CountAndWarn("test folders\Amazon", itm, 2, 600)
End Sub
Public Sub Wayfair(ByRef itm As MailItem)
Call CountAndWarn("test folders\Wayfair", itm, 2, 600)
End Sub
Sub CountAndWarn(ByVal FldrDestName As String, ByRef itm As MailItem, _
ParamArray CountPeriod() As Variant)
Dim CountsCrnt() As Long
Dim CountsTgt() As Long
Dim FldrDest As Outlook.Folder
Dim FldrDestNamePart() As String
Dim FldrOld As Outlook.Folder
Dim InxC As Long
Dim InxCS As Long
Dim InxFldrName As Long
Dim InxItem As Long
Dim LB As Long
Dim Msg As String
Dim NumCounts As Long
Dim Periods() As Date
Dim Recent As Boolean
Dim Warn As Boolean
FldrDestNamePart = Split(FldrDestName, "\")
LB = LBound(FldrDestNamePart) ' Should be zero but just in case
' Set FldrDest to Store
On Error Resume Next
Set FldrDest = Session.Folders(FldrDestNamePart(LB))
On Error GoTo 0
If FldrDest Is Nothing Then
Debug.Assert False ' Store doesn't exist
Exit Sub
End If
' Set FldrDest to destination folder
For InxFldrName = LB + 1 To UBound(FldrDestNamePart)
On Error Resume Next
Set FldrDest = FldrDest.Folders(FldrDestNamePart(InxFldrName))
On Error GoTo 0
If FldrDest Is Nothing Then
Debug.Assert False ' Subfolder doesn't exist
Exit Sub
End If
Next
'Set FldrOld to the Old folder for FldrDest
On Error Resume Next
Set FldrOld = FldrDest.Folders("Old")
On Error GoTo 0
If FldrOld Is Nothing Then
Debug.Assert False ' No subfolder "Old" within destination folder
Exit Sub
End If
' Move new email from Inbox to FldrDest
itm.Move FldrDest
'Debug.Print "CountPeriod";
'For InxCS = LBound(CountSince) To UBound(CountSince)
'Debug.Print " " & CountSince(InxCS);
'Next
'Debug.Print
' Determine number of counts and periods in CountPeriod
' No check for an odd number of values in CountPeriod
NumCounts = (UBound(CountPeriod) - LBound(CountPeriod) + 1) / 2
' Size arrays according to number of counts
ReDim CountsCrnt(1 To NumCounts)
ReDim CountsTgt(1 To NumCounts)
ReDim Periods(1 To NumCounts)
' Initialise arrays and convert periods in minutes to a time
InxC = 1
For InxCS = LBound(CountPeriod) To UBound(CountPeriod) Step 2
CountsTgt(InxC) = CountPeriod(InxCS)
CountsCrnt(InxC) = 0
Periods(InxC) = DateAdd("n", -CountPeriod(InxCS + 1), Now())
InxC = InxC + 1
Next
'Debug.Print FldrDest.Name
'Debug.Print "New " & itm.ReceivedTime
For InxItem = FldrDest.Items.Count To 1 Step -1
With FldrDest.Items(InxItem)
'Debug.Print .ReceivedTime & " ";
Recent = False
For InxC = 1 To NumCounts
If .ReceivedTime > Periods(InxC) Then
CountsCrnt(InxC) = CountsCrnt(InxC) + 1
Recent = True
Exit For
End If
Next
End With
If Recent Then
'Debug.Print "Index " & InxC & " Count " & CountsCrnt(InxC)
Else
'Debug.Print "Old: Moved"
FldrDest.Items(InxItem).Move FldrOld
End If
Next
' Check counts to see if warning required
Warn = False
For InxC = 1 To NumCounts
If InxC > 1 Then
' Add in count of more recent emails
CountsCrnt(InxC) = CountsCrnt(InxC) + CountsCrnt(InxC - 1)
'Debug.Print "CountsCrnt(InxC) := " & CountsCrnt(InxC)
End If
If CountsCrnt(InxC) >= CountsTgt(InxC) Then
Warn = True
End If
Next
If Warn Then
' At least one count in excess of maximum
Msg = "Warning. Emails in " & FldrDestName
For InxC = 1 To NumCounts
Msg = Msg & vbLf & CountsCrnt(InxC) & " since " & Format(Periods(InxC), "ddd h:mm:ss")
Next
Call MsgBox(Msg, vbOKOnly)
End If
End Sub