Forward email based on part of a subject line - vba

Question

Is there a way to search an inbox for a part of a subject line from an email then forward the search results to another email address?
Example:
COMPLETE email comes into inbox, subject line of the email is “This is the subject COMPLETE”. I want any emails with “subject” in the subject line to be forwarded to a different email address.
EDIT: To clarify, the macro should search the subject line for a combination of letters and numbers, always 15 characters long, to the left of COMPLETE.
Also, the macro would not need to be triggered when the COMPLETE email comes into the inbox (ok to be triggered manually). It would need to treat each complete email as a separate “job” to repeat the search and forward for each email with complete in the subject.

Answer 1

I will try to get you started but only you can debug any code as only you have the emails you wish to forward. I have created some emails that match my understanding of your emails but I cannot be sure I have got then perfectly correct.
I do not know how much VBA you know. In general, once you know a statement exists, it is fairly easy to search the web for an explanation. So I will concentrate of explaining what my code is doing.
For the first stage of your macro you need to gather the following information:
abcdefghijklmno Email1 Email2 Email3 . . .
bcdefghijklmnop Email4 Email5 . . .
where “abcdefghijklmno” and “bcdefghijklmnop” are the code for a ‘job’ and Email1 to Email5 are the emails whose subjects include the codes.
For a macro a folder, such as Inbox, is a collection. There are different ways of identifying a particular Email but I think the most convenient way for your requirement is by its position or index within the collection. The first email added to a folder will have an index of 1, the second and index of 2 and so on. If you know about arrays, this will seem familiar. The difference is that with collections you can delete existing items from or add new items in the middle of the collection. Suppose, I have a collection with items A, B, C, E and F which will have indices 1 to 5. I now add item D between items C and E. Items A to C are still items 1 to 3. But D is now item 4, E has become item 5 and F has become item 6. You have the opposite situation when an item is deleted with items further down the collection having their index numbers reduced. This is probably strange but I believe it will become clearer later when it becomes important.
So what we need to create is:
abcdefghijklmno 25 34 70 . . .
bcdefghijklmnop 29 123 . . .
After Option Explicit, which you can look up, the first statement is Type tFamily. VBA comes with a wide variety of data types, for example: Long, Double, String and Boolean. Sometimes these are not enough on their own and we need to combine them into what VBA calls user types and most other languages call structures. You may have heard of classes. Classes are a step up from user types and we do not need their extra functionality or extra complications.
So I have written:
Type tFamily
Code As String
Members As Collection
End Type
Here I have combined a String and a Collection into a larger type which I have named tFamily. The “t” is my standard because I often have difficulty thinking of different names for my types and my variables. This type matches the data I describe above. I have called all the emails with the same code a Family. Within a family, I have a string to hold the code and a collection to hold all the indices.
Further down my code, I have defined an array of families:
Dim Families() As tFamily
This is where I will hold all the information about the email families.
The next important statement is:
Set FldrInbox = Session.Folders("xxx").Folders("Inbox")
You need to replace “xxx” with the name of the shared mailbox.
The first block of code, headed Identify the 'COMPLETE' emails and record their indices in InxsItemComplete scans through all the emails in Inbox and records the index of each email with a subject ending “COMPLETE”. With the example data above, at the end, InxsItemComplete would contain 123 and 70.
The next statement is ReDim Families(1 To InxsItemComplete.Count). InxsItemComplete.Count is the number of complete families. This statement sizes array Families so it can hold this number of families. It is possible to have collections within collection but collections within an array are simpler.
The next block extracts the code from each ‘COMPLETE’ and stores it and the index of the ‘COMPLETE’ email in Families. The code assumes the emails subject is something like:
xxxxxxxxxx abcdefghijklmno spaces COMPLETE
The code sets PosCodeEnd to point before “COMPLETE”. It backs up until it finds a non-space and then extracts the previous 15 characters. This code is then stored in Families(InxF).Code. The index of the email is added to Families(InxF).Members.
The next block again scans through all the emails in Inbox. This time it is looks for emails with subjects that contain a code but do not end with “COMPLETE”. It adds the index of these emails to Families(InxF).Members. These indices are added so these are in ascending sequence. I will explain why this sequence is important when I add the next stage of this macro which forwards the emails.
This is the end of stage 1. All the data needed for forwarding emails has been collected. The remaining block of code outputs the data to the Immediate Window so it can be checked. With my test emails, that output is:
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
The important part of this data is:
abcdefghijklmno
122
124
126
127
zyxwvutsrqponml
121
123
125
That is the codes and the indices are the recorded data. The received time and subject are to help you identify the referenced emails.
You need to run this macro and check this output for:
Every email with a subject ending “COMPLETE” has been identified.
The code has been correctly extracted.
Every email containing a code has been found and recorded.
The indices are in ascending sequence for each code.
Come back with questions as necessary. However, remember I cannot see your emails so there is a limit to how much I can help with the debugging. Once you confirm that the diagnostic output is correct, I will add the code for stage 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