Forward email based on part of a subject line

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