Из вашего вопроса я предполагаю, что вы надеялись, что кто-то уже разработал решение вашей проблемы. Возможно, у них есть, но я думаю, что вряд ли они опубликуют это решение для других. Я думаю, вам придется разработать собственное решение. Подход, который я разработал, сильно отличается от подхода Юджина. Между нами мы предлагаем несколько интересных идей для выбора.
Я не верю, что необходимый VBA особенно продвинут. Возможно, вы уже знаете достаточно, особенно с двумя ответами на учебу. Если нет, я бы начал с Excel VBA. Мне не удалось найти учебник по Outlook VBA, который мне нравится, но я видел несколько учебников по Excel VBA, которые выглядят хорошо. Я предпочитаю книги. Я посетил хорошую библиотеку, посмотрел несколько учебников по Excel VBA и позаимствовал у себя самые многообещающие, чтобы попробовать дома.
Вам также необходимо понять объектную модель 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 - это макрос, который я написал для обработки всех этих писем. Он имеет как минимум четыре параметра, но может иметь шесть, восемь или более, если это будет полезно для определенного типа электронной почты.
«test folder \ Xxxxx» определяет папку, в которую следует переместить письмо.
Если вы посмотрите на свою OuНа панели папок tlook вы увидите хотя бы одно имя на левом краю. Под этим, но с отступом, будут находиться системные папки, такие как Входящие, Удаленные, Отправленные и Исходящие. В любой из системных папок вы можете иметь частные подпапки. Вы также можете иметь личные папки на том же уровне, что и системные папки, любая из которых может иметь подпапки и подпапки любой глубины. Имя на левом краю обозначает магазин. Магазин - это файл, в котором Outlook хранит электронную почту, встречи, задачи и так далее. У вас будет хотя бы один магазин, в который загружаются ваши электронные письма. Вы также можете иметь общие магазины, которые могут быть открытыми для всей вашей организации или частными для вашей команды или отдела. Вы можете купить их во многих частных магазинах.
В моей системе у меня есть один магазин на один адрес электронной почты (у меня три) плюс несколько частных магазинов. В «тестовых папках \ Xxxxx» «тестовые папки» - это имя частного магазина, который я использую для экспериментов. В «тестовых папках» я создал четыре папки, по одной на каждого поставщика, которого я отслеживаю. В каждой из этих папок у меня есть подпапка «Старая», которую я объясню позже. Итак, на панели папок у меня есть раздел, который выглядит так:
test folders
Xxxxx
Old
Wwwww
Old
Vvvvv
Old
Uuuuu
Old
Как я уже сказал, "test folder \ 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, чтобы оно могло переместить письмо в указанную папку.
Остальные параметры представляют собой одну или несколько пар целых чисел, из которых первое - это количество писем, а второе - количество минут. Мой список параметров означает, что я хотел бы получить предупреждение, если:
- За последние 180 минут пришло 2 письма от поставщика Xxxxx
- 3 электронных письма пришли за последние 600 минут от поставщика Xxxxx
Я не получаю много таких писем в день, поэтому у меня низкие показатели и длительные периоды. Ваш счет будет намного выше, а ваши периоды намного короче.
Я не знаю, возможно, вы захотите отслеживать разные периоды, но было немного дополнительного кода для нескольких периодов, поэтому я включил его. У вас должен быть хотя бы один счет и один период, но вы можете иметь столько дополнительных пар, сколько пожелаете. Если у вас есть несколько периодов, они должны быть в порядке возрастания с последним самым длинным периодом.
Макрос CountAndWarn выполняет следующие действия:
- Найдите именованную папку назначения, например, «test folder \ Xxxxx».
- Найдите соответствующую «старую» папку, например, «тестовые папки \ Xxxxx \ Old».
- Переместить письмо в папку назначения
- Подсчет писем за каждый период. Если электронное письмо старше, чем время окончания последнего периода, переместите его в «старую» папку, чтобы оно не проверялось при каждом поступлении нового электронного письма.
- Если какой-либо из счетчиков превышает максимум для своего периода, отображается окно сообщения, подобное следующему.
Эти макросы могут быть идеальными, если все, что вам нужно, это мгновенное предупреждение о каждом пике в течение дня. Недостатки включают в себя:
- Пока всплеск продолжается, вы будете получать предупреждения о каждом новом письме.
- Вы не будете предупреждены о всплеске посреди ночи.
Первый недостаток могне может быть исправлено без учета записей.Например, макрос 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