我会尝试让您开始，但只有您可以调试任何代码，因为只有您拥有要转发的电子邮件。我创建了一些符合我对您的电子邮件理解的电子邮件，但我不能确定我是否完全正确。
我不知道你对 VBA 了解多少。一般来说，一旦你知道有一个陈述存在，就很容易在网上搜索解释。所以我将集中解释我的代码在做什么。
对于宏的第一阶段，您需要收集以下信息：
abcdefghijklmno Email1 Email2 Email3 . . .
bcdefghijklmnop Email4 Email5 . . .
其中“abcdefghijklmno”和“bcdefghijklmnop”是“工作”的代码，Email1 到 Email5 是主题包含代码的电子邮件。
对于宏，文件夹（例如收件箱）是一个集合。有不同的方法可以识别特定的电子邮件，但我认为最方便的方法是通过它在集合中的位置或索引。添加到文件夹的第一封电子邮件的索引为 1，第二封电子邮件的索引为 2，依此类推。如果您了解数组，这似乎很熟悉。不同之处在于，对于集合，您可以从集合中删除现有项目或在集合中间添加新项目。假设，我有一个包含项目 A、B、C、E 和 F 的集合，它们的索引为 1 到 5。我现在在项目 C 和 E 之间添加项目 D。项目 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
在这里，我将 String 和 Collection 组合成一个更大的类型，我将其命名为 tFamily。 “t”是我的标准，因为我经常难以为我的类型和变量考虑不同的名称。这种类型与我上面描述的数据相匹配。我已将所有具有相同代码的电子邮件称为家庭。在一个家庭中，我有一个字符串来保存代码和一个集合来保存所有索引。
在我的代码中，我定义了一系列家庭：
Dim Families() As tFamily
我将在这里保存有关电子邮件系列的所有信息。
下一个重要的声明是：
Set FldrInbox = Session.Folders("xxx").Folders("Inbox")
您需要将“xxx”替换为共享邮箱的名称。
第一个代码块，标题为识别'COMPLETE'电子邮件并在InxsItemComplete中记录它们的索引扫描收件箱中的所有电子邮件并记录每封电子邮件的索引，主题以“COMPLETE”结尾.对于上面的示例数据，最后，InxsItemComplete 将包含 123 和 70。
下一条语句是ReDim Families(1 To InxsItemComplete.Count)。 InxsItemComplete.Count 是完整家庭的数量。该语句大小数组Families，因此它可以容纳这个数量的家庭。集合中可以有集合，但数组中的集合更简单。
下一个块从每个“COMPLETE”中提取代码并将其和“COMPLETE”电子邮件的索引存储在Families 中。该代码假定电子邮件主题类似于：
xxxxxxxxxx abcdefghijklmno spaces COMPLETE
代码将PosCodeEnd 设置为指向“COMPLETE”之前。它会进行备份，直到找到一个非空格，然后提取前 15 个字符。然后此代码存储在Families(InxF).Code 中。邮件索引添加到Families(InxF).Members。
下一个块再次扫描收件箱中的所有电子邮件。这次它会查找主题包含代码但不以“COMPLETE”结尾的电子邮件。它将这些电子邮件的索引添加到Families(InxF).Members。这些索引被添加，因此它们是升序的。当我添加转发电子邮件的宏的下一个阶段时，我将解释为什么这个顺序很重要。
第 1 阶段到此结束。转发电子邮件所需的所有数据均已收集完毕。剩余的代码块将数据输出到即时窗口，以便对其进行检查。使用我的测试电子邮件，该输出是：
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
即代码和索引是记录的数据。收到的时间和主题是为了帮助您识别引用的电子邮件。
您需要运行此宏并检查以下输出：
- 已识别出每封主题以“COMPLETE”结尾的电子邮件。
- 代码已正确提取。
- 已找到并记录每封包含代码的电子邮件。
- 每个代码的索引按升序排列。
如有必要，请回来提出问题。但是，请记住，我看不到您的电子邮件，因此我对调试的帮助是有限的。确认诊断输出正确后，我将添加第 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