Я постараюсь начать, но только вы можете отлаживать любой код, так как только у вас есть письма, которые вы хотите переслать. Я создал несколько электронных писем, которые соответствуют моему пониманию ваших электронных писем, но я не могу быть уверен, что получил их тогда совершенно правильно.
Я не знаю, сколько VBA вы знаете. В общем, когда вы знаете, что утверждение существует, довольно легко найти объяснение в Интернете. Поэтому я сосредоточусь на объяснении того, что делает мой код.
Для первого этапа вашего макроса вам необходимо собрать следующую информацию:
abcdefghijklmno Email1 Email2 Email3 . . .
bcdefghijklmnop Email4 Email5 . . .
где «abcdefghijklmno» и «bcdefghijklmnop»это код «задания», а от Email1 до Email5 - это электронные письма, темы которых включают коды.
Для макроса папка, такая как Входящие, является коллекцией. Существуют разные способы идентификации конкретного электронного письма, но я думаю, что наиболее удобный способ для вашего требования - это его позиция или индекс в коллекции. Первое письмо, добавленное в папку, будет иметь индекс 1, второе и индекс 2 и так далее. Если вы знаете о массивах, это покажется вам знакомым. Разница в том, что с коллекциями вы можете удалять существующие элементы или добавлять новые элементы в середине коллекции. Предположим, у меня есть коллекция с элементами A, B, C, E и F, которая будет иметь индексы от 1 до 5. Теперь я добавляю элемент D между элементами C и E. Элементы от A до C по-прежнему являются элементами с 1 по 3. Но D - этотеперь элемент 4, E стал элементом 5, а F стал элементом 6. У вас возникает противоположная ситуация, когда элемент удаляется с элементами, находящимися ниже в коллекции, с уменьшением их порядковых номеров. Это, вероятно, странно, но я считаю, что это станет яснее позже, когда станет важным.
Итак, нам нужно создать:
abcdefghijklmno 25 34 70 . . .
bcdefghijklmnop 29 123 . . .
После Option Explicit, который вы можете посмотретьпервое утверждение Type tFamily. VBA поставляется с большим разнообразием типов данных, например: Long, Double, String и Boolean. Иногда этого недостаточно, и нам нужно объединить их в то, что VBA называет типами пользователей, а большинство других языков называют структурами. Возможно, вы слышали о занятиях. Классы являются шагом вперед по сравнению с пользовательскими типами, и нам не нужны их дополнительные функциональные возможности или дополнительные сложности.
Итак, я написал:
Type tFamily
Code As String
Members As Collection
End Type
Здесь я соединил строку и коллекцию вбольший тип, который я назвал tFamily. «Т» - это мой стандарт, потому что мне часто трудно думать о разных именах для моих типов и переменных. Этот тип соответствует данным, которые я описал выше. Я назвал все электронные письма с одним и тем же кодом семьей. Внутри семьи у меня есть строка для хранения кода и коллекция для хранения всех индексов.
Далее в моем коде я определил массив семейств:
Dim Families() As tFamily
Thisздесь я буду хранить всю информацию о семействах электронных писем.
Следующее важное утверждение:
Set FldrInbox = Session.Folders("xxx").Folders("Inbox")
Вам необходимо заменить «xxx» на имя общего почтового ящика.
Первый блок кода, озаглавленный Идентифицирует электронные письма «ЗАВЕРШЕНО» и записывает их индексы в InxsItemComplete сканирует все электронные письма в папке «Входящие» и записывает индекс каждого электронного письма с темой, заканчивающейся «ЗАВЕРШИТЬ»». С данными примера выше, в конце, InxsItemComplete будет содержать 123 и 70.
Следующим оператором является ReDim Families(1 To InxsItemComplete.Count). InxsItemComplete.Count - количество полных семей. Этот оператор определяет массив Families, поэтому он может содержать это количество семействМожно иметь коллекции внутри коллекции, но коллекции внутри массива проще.
Следующий блок извлекает код из каждого «ЗАВЕРШЕНО» и сохраняет его, а также индекс электронного письма «ЗАВЕРШЕНО» в Families. Код предполагает, что тема электронного письма выглядит примерно так:
xxxxxxxxxx abcdefghijklmno spaces COMPLETE
Код устанавливает PosCodeEnd, чтобы указывать перед «ЗАВЕРШИТЬ». Он выполняет резервное копирование до тех пор, пока не найдет не пробел, а затем извлечет предыдущие 15 символов. Этот код затем сохраняется в Families(InxF).Code. Индекс электронной почты добавляется к Families(InxF).Members.
Следующий блок снова сканируетхотя все письма в Inbox. На этот раз он ищет электронные письма с темами, которые содержат код, но не заканчиваются на «ЗАВЕРШЕНО». Добавляет индекс этих писем к Families(InxF).Members. Эти индексы добавляются в порядке возрастания. Я объясню, почему эта последовательность важна, когда я добавлю следующий этап этого макроса, который пересылает электронные письма.
Это конец первого этапа. Все данные, необходимые для пересылки электронных писем, были собраны. Оставшийся блок кода выводит данные в Immediate Window, чтобы их можно было проверить. В моих тестовых электронных письмах это выводится:
abcdefghijklmno
122 06/10/2019 13:28:38 Introductory text aaa abcdefghijklmno Progress
124 06/10/2019 13:27:35 Introductory text ccccc abcdefghijklmno Progress
126 06/10/2019 13:26:05 Introductory text ccccc abcdefghijklmno Progress
127 06/10/2019 13:24:54 Introductory text aaa abcdefghijklmno COMPLETE
zyxwvutsrqponml
121 06/10/2019 13:29:10 Introductory text bbbbbb zyxwvutsrqponml COMPLETE
123 06/10/2019 13:28:00 Introductory text bbbbbb zyxwvutsrqponml Progress
125 06/10/2019 13:26:38 Introductory text aaa zyxwvutsrqponml Progress
Важная часть этих данных:
abcdefghijklmno
122
124
126
127
zyxwvutsrqponml
121
123
125
То есть коды и индексы являются записанными данными. Полученное время и тема должны помочь вам идентифицировать ссылочные электронные письма.
Вам необходимо запустить этот макрос и проверить следующие выходные данные:
- Каждое письмо с темой, заканчивающейся «ЗАВЕРШЕНО»
- Код был правильно извлечен.
- Каждое письмо, содержащее код, было найдено и записано.
- Индексы в порядке возрастания для каждого кода.
Вернитесь с вопросами по мере необходимости. Однако помните, что я не могу видеть ваши электронные письма, поэтому существует предел того, насколько я могу помочь с отладкой. Как только вы подтвердите, что диагностический вывод верен, я добавлю код для этапа 2.
Option Explicit
Type tFamily
Code As String
Members As Collection
End Type
Sub FindAndForwardCompleteConversations()
Dim Families() As tFamily
Dim FldrInbox As Folder
Dim InxItemCrnt As Long
Dim InxF As Long ' Index into Families and InxsItemComplete
Dim InxM As Long ' Index into members of current family
Dim InxsItemComplete As New Collection
Dim Placed As Boolean
Dim PosCodeEnd As Long
Dim Subject As String
Set FldrInbox = Session.Folders("xxx").Folders("Inbox")
' Identify the 'COMPLETE' emails and record their indices
For InxItemCrnt = FldrInbox.Items.Count To 1 Step -1
With FldrInbox.Items.Item(InxItemCrnt)
If .Class = olMail Then
If Right$(.Subject, 8) = "COMPLETE" Then
InxsItemComplete.Add InxItemCrnt
End If
End If
End With
Next
ReDim Families(1 To InxsItemComplete.Count)
' Extract code from each "COMPLETE" emails and start families with 'COMPLETE' email
For InxF = 1 To InxsItemComplete.Count
Subject = FldrInbox.Items.Item(InxsItemComplete(InxF)).Subject
PosCodeEnd = Len(Subject) - 8 ' Position to space before COMPLETE
' Position to first non-space character before COMPLETE
Do While Mid$(Subject, PosCodeEnd, 1) = " "
PosCodeEnd = PosCodeEnd - 1
Loop
Families(InxF).Code = Mid$(Subject, PosCodeEnd - 14, 15)
Set Families(InxF).Members = New Collection
Families(InxF).Members.Add InxsItemComplete(InxF)
Next
Set InxsItemComplete = Nothing ' Release memory of collection which is no longer needed
' Identify emails containing the same code as the 'COMPLETE' emails
' and add to the appropriate Family
For InxItemCrnt = FldrInbox.Items.Count To 1 Step -1
With FldrInbox.Items.Item(InxItemCrnt)
If .Class = olMail Then
Placed = False
For InxF = 1 To UBound(Families)
If Right$(.Subject, 8) <> "COMPLETE" And _
InStr(1, .Subject, Families(InxF).Code) <> 0 Then
' Add InxItemCrnt to collection of members for this family
' so that indices are in ascending sequence
For InxM = 1 To Families(InxF).Members.Count
If InxItemCrnt < Families(InxF).Members(InxM) Then
Families(InxF).Members.Add Item:=InxItemCrnt, Before:=InxM
Placed = True
Exit For
End If
Next
If Not Placed Then
Families(InxF).Members.Add Item:=InxItemCrnt
Placed = True
End If
End If
If Placed Then
' Email added to current family so not need to check other families
Exit For
End If
Next
End If
End With
Next
' Output collected information
For InxF = 1 To UBound(Families)
Debug.Print Families(InxF).Code
For InxM = 1 To Families(InxF).Members.Count
InxItemCrnt = Families(InxF).Members(InxM)
With FldrInbox.Items.Item(InxItemCrnt)
Debug.Print " " & InxItemCrnt & " " & .ReceivedTime & " " & .Subject
End With
Next
Next
End Sub