我每天都会收到数百个自动警报（例如 CPU/内存峰值、SQL 块）。但是，通常情况下，当这些警报出现时，我无能为力/不想做；我只关心警报激增的时候，因为那是不正常的。我至少让他们去分开文件夹，但这仍然让人分心，因为我必须始终注意那个未读的电子邮件号码。
当我在 N 分钟内收到超过 X 封来自 sendername 的电子邮件时，有什么方法可以提醒我吗？
使用 Outlook、Office 365
我尝试寻找 Outlook 加载项，但很难向 Google 描述这个问题。我知道一点点 VBA，但不足以让我开始。
【问题讨论】：
标签： vba outlook outlook-addin
基本上，您必须运行一个计时器来定期运行扫描程序来检测到达您收件箱的电子邮件数量。在计时器触发的事件处理程序（通常称为Tick）中，您可以使用Items 类的Find/FindNext 或Restrict 方法。
最简单、最快的方法是创建 VBA 宏。请参阅 Getting started with VBA in Office 和 Using Visual Basic for Applications in Outlook 文章以快速入门。
以下文章可以帮助您在描述的方法之上编写所需的算法来查找 Outlook 项目：
要定期运行计时器，您可以使用SetTimer 函数。 示例代码见Outlook VBA - Run a code every half an hour。
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
【讨论】：
我从您的问题中假设您希望有人已经为您的问题制定了解决方案。也许他们有，但我认为他们不太可能发布该解决方案供其他人查找。我认为您将不得不开发自己的解决方案。我开发的方法与尤金的方法非常不同。在我们之间，我们提供了一些有趣的想法供您选择。
我认为所需的 VBA 并不特别先进。你可能已经知道得够多了，尤其是有两个答案要研究。如果没有，我将从 Excel VBA 开始。我没有找到我喜欢的 Outlook VBA 教程，但我看到了几个看起来不错的 Excel VBA 教程。我更喜欢书。我参观了一个不错的图书馆，看了几本 Excel VBA Primers 并借了最有希望的在家里尝试。
您还需要了解 Outlook 对象模型。 Excel VBA 教程将教您有关工作簿、工作表、范围、单元格等的知识。对于 Outlook，您需要了解存储、文件夹、邮件项目、日历项目等。正如我所说，我没有找到我喜欢的 Outlook VBA 教程，我不喜欢我购买的高度推荐的书。我通过实验学习了 Outlook VBA。尤金在他的回答中包含了解释，我将在我的回答中包含解释。希望我们之间能给你足够的开始。您可能会很幸运地找到一篇同时解释主题 A、B 和 C 的帖子。我发现单独查找主题然后编写将它们组合起来的实验宏会更好。如果您在实验性宏上失败，请在此处发布，并说明您要实现的目标以及出了什么问题；你几乎肯定会得到帮助。
为了模拟您的问题，我挑选了四家供应商，这些供应商经常给我发电子邮件，以开发和测试我的监控代码。您说您使用规则将这些电子邮件移动到单独的文件夹中，这对我来说似乎是个好主意。规则提供了许多可以选择电子邮件的分类，我认为您可以从输入流中选择这些电子邮件。规则还提供了数字处理选项。您已使用“移动到文件夹”。另一个是“运行脚本”。此上下文中的脚本是具有特定结构的 Outlook VBA 宏。我有信心，我可以创建一个宏来执行您需要的监控。但是，有一个问题：Outlook 在将电子邮件移动到新文件夹之前运行宏。这不是一个大问题，但这意味着您不能使用该规则来移动电子邮件。您必须获得宏才能移动电子邮件，这并不困难。
我为每个供应商创建了一个规则，其摘要是：
Apply this rule after the message arrives
from Xxxxx
and on this computer only
run Project1.Yyyyy
and stop processing more rules
“Xxxxx”是供应商的名称，“Yyyyy”是处理电子邮件的宏的名称。我是家庭用户，所以“仅在这台计算机上”对我没有影响，但对你可能会影响。如果没有“并停止处理更多规则”，您将收到消息说找不到电子邮件，因为规则 X 移动了电子邮件，然后规则 Y 在收件箱中找不到它。
宏 Yyyyy 的形式为：
Public Sub Yyyyy(ByRef itm As MailItem)
Call CountAndWarn("test folders\Xxxxx", itm, 2, 180, 3, 600)
End Sub
宏的名称并不重要。显然，如果一条规则说运行宏 Yyyyy，则必须有一个宏 Yyyyy，但 Yyyyy 的值并不重要。我以 Outlook 的供应商名称命名了我的宏，但您可能必须根据电子邮件类型来命名它们。
第一行的格式Public Sub Yyyyy(ByRef itm As MailItem) 或多或少是固定的，以便由规则运行宏。第一个参数必须是 MailItem。还有一些我从未使用过的可选参数。
CountAndWarn 是我编写的用于处理所有这些电子邮件的宏。它至少有四个参数，但如果对特定类型的电子邮件有帮助，它可以有六个或八个或更多。
“测试文件夹\Xxxxx”标识电子邮件要移动到的文件夹。
如果您查看 Outlook 文件夹窗格，您会在左边缘看到至少一个名称。在此之下，但缩进的是系统文件夹，例如收件箱、已删除邮件、已发送邮件和发件箱。在任何系统文件夹下，您都可以拥有私有子文件夹。您还可以拥有与系统文件夹处于同一级别的私人文件夹，其中任何一个都可以拥有任何深度的子文件夹和子子文件夹。左边的名称标识了一家商店。存储是 Outlook 存储电子邮件、约会、任务等的文件。您将至少有一个商店用于加载您的电子邮件。您可能还拥有共享商店，这些商店可以对您的整个组织公开或对您的团队或部门私有。您可以随心所欲地在许多私人商店购买。
在我的系统上，每个电子邮件地址都有一个商店（我有三个），外加几家私人商店。在“测试文件夹\Xxxxx”中，“测试文件夹”是我用于实验的私人商店的名称。在“测试文件夹”中，我创建了四个文件夹，我监控的每个供应商一个。在每个文件夹中，我都有一个子文件夹“Old”，稍后我会解释。所以在我的文件夹窗格中，我有一个看起来像这样的部分：
test folders
Xxxxx
Old
Wwwww
Old
Vvvvv
Old
Uuuuu
Old
正如我所说，“测试文件夹\Xxxxx”标识一个文件夹。此字符串的格式为“StoreName\FolderName\SubFolderName\SubSubFolderName ...”。我把我的文件夹放在了一个实验商店里；您可能已将文件夹放在主存储中。您可以将它们放置在您具有写入权限的任何位置。此字符串必须指定以商店名称开头的文件夹的完整名称。你的名字可能是：“YourMainStore\Inbox\CPU Spikes”和“YourMainStore\Inbox\SQL Blocks”。
返回Call CountAndWarn("test folders\Xxxxx", itm, 2, 180, 3, 600)。
第二个参数 itm 将电子邮件传递给CountAndWarn，因此它可以将电子邮件移动到指定的文件夹。
其余参数是一对或多对整数，其中第一个是电子邮件计数，第二个是分钟数。我的参数列表意味着我希望在以下情况下收到警告：
我每天不会收到很多这样的电子邮件，所以我的数量很少，而且我的月经很长。您的计数会更高，而您的月经会更短。
我不知道您是否希望监控不同的时期，但几乎没有额外的代码可以允许多个时期，所以我将它包括在内。您必须至少有一个计数和一个句点，但您可以拥有任意多的额外对。如果您有多个句点，它们必须按升序排列，最长的句点在最后。
宏 CountAndWarn 执行以下操作：
如果您只想对一天中的每个峰值发出即时警告，这些宏可能是理想的选择。不足之处包括：
如果不保留记录，就无法修复第一个缺陷。例如，宏 CountAndWarn 计算文件夹中的电子邮件并报告高计数。它没有记录它在最后一封电子邮件到达时十秒前警告您当前的峰值。将记录保存在文本文件中并不难，但您需要考虑哪些记录可以帮助您分析峰值。
半夜的高峰需要分析旧电子邮件。当前的宏只计算最后 X 分钟内的电子邮件。查看昨晚的电子邮件将涉及自昨天比赛结束后每 X 分钟内计算电子邮件。这种分析可能不需要任何晦涩难懂的 VBA，但需要一些仔细的设计。
如果您不理解以下宏中的任何内容，请回来提问：
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
【讨论】：