Assign incoming mail a category if subject has a match in one of multiple arrays of text

Question

Goal: Code in ThisOutlookSession.
I am missing the condition for array 0 and the other arrays (1 to 4) are not in array form. See my code below. Where Array 0 = #G126A, #G156A, #G186B, #GA265, #GH264A

IF the subject includes value in (array0)
    THEN Exit

ELSEIF the subject includes value in (array1)
    THEN assign category CAT1

ELSEIF the subject includes value in (array2)
    THEN assign category CAT2

ELSEIF the subject includes value in (array3)
    THEN assign category CAT3

ELSEIF the subject includes value in (array4)
    THEN assign category CAT4

Option Explicit

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
lbl_Exit:
Exit Sub
End Sub

Private Sub Items_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
If TypeName(item) = "MailItem" Then
    AutoCategorize item
End If
lbl_Exit:
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Err.Clear
    GoTo lbl_Exit
End Sub

In a normal module enter the modified version of the code below, then restart Outlook (or manually run Application_Startup) to activate the event.

Public Sub AutoCategorize(olItem As MailItem)
With olItem
    If InStr(1, myitem.Subject, "100001") > 0 Or _
      InStr(1, myitem.Subject, "103401") > 0 Or _
      InStr(1, myitem.Subject, "108401") > 0 Or _
      InStr(1, myitem.Subject, "800899") > 0 Or _
      InStr(1, myitem.Subject, "800795") > 0 Or _
      InStr(1, myitem.Subject, "800755") > 0 Or _
      InStr(1, myitem.Subject, "800617") > 0 Or _
      InStr(1, myitem.Subject, "850519") > 0 Or _
      InStr(1, myitem.Subject, "212485") > 0 Then

        olItem.Categories = "CAT1"
        olItem.Save

    ElseIf InStr(1, myitem.Subject, "800880") > 0 Or _
      InStr(1, myitem.Subject, "221315") > 0 Or _
      InStr(1, myitem.Subject, "004083") > 0 Or _
      InStr(1, myitem.Subject, "218713") > 0 Or _
      InStr(1, myitem.Subject, "800824") > 0 Or _
      InStr(1, myitem.Subject, "004131") > 0 Or _
      InStr(1, myitem.Subject, "800404") > 0 Or _
      InStr(1, myitem.Subject, "020082") > 0 Or _
      InStr(1, myitem.Subject, "212445") > 0 Then
        olItem.Categories = "CAT2"
        olItem.Save
    
    ElseIf InStr(1, myitem.Subject, "215007") > 0 Or _
      InStr(1, myitem.Subject, "215989") > 0 Or _
      InStr(1, myitem.Subject, "005306") > 0 Or _
      InStr(1, myitem.Subject, "004025") > 0 Or _
      InStr(1, myitem.Subject, "060068") > 0 Or _
      InStr(1, myitem.Subject, "060193") > 0 Or _
      InStr(1, myitem.Subject, "030002") > 0 Or _
      InStr(1, myitem.Subject, "060103") > 0 Or _
      InStr(1, myitem.Subject, "217811") > 0 Then
        olItem.Categories = "CAT3"
        olItem.Save

    ElseIf InStr(1, myitem.Subject, "060001") > 0 Or _
      InStr(1, myitem.Subject, "215720") > 0 Or _
      InStr(1, myitem.Subject, "030001") > 0 Or _
      InStr(1, myitem.Subject, "030445") > 0 Or _
      InStr(1, myitem.Subject, "030388") > 0 Or _
      InStr(1, myitem.Subject, "030070") > 0 Or _
      InStr(1, myitem.Subject, "060065") > 0 Or _
      InStr(1, myitem.Subject, "601003") > 0 Or _
      InStr(1, myitem.Subject, "203093") > 0 Then
        olItem.Categories = "CAT4"
        olItem.Save
    End If
End With
lbl_Exit:
    Exit Sub
End Sub

Answer 1

Basically you can write four loops to iterate over all items in arrays and assign a category if the subject contains a substring with an array's item.

For Each item In arrCategoryFour
  If InStr(1, myitem.Subject, item) > 0 Then
    olItem.Categories = "CAT1"
    olItem.Save
  End If
Next item

Isn't better to just create Outlook rules manually if all items in arrays are know at design-time?

Anyway, you may find the Getting started with VBA in Office article helpful.

Answer 2

It will be tedious to generate arrays but it could be done this way.

Comment on previous answer post:
"some values are used multiple times between categories"

Private WithEvents Items As Items

Private Sub Application_Startup()
Set Items = Session.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub Items_ItemAdd(ByVal item As Object)
If TypeOf item Is MailItem Then
    AutoCategorize item
End If
End Sub


Public Sub AutoCategorize(olItem As MailItem)

Dim array0 As Variant
Dim array1 As Variant
Dim array2 As Variant
Dim array3 As Variant
Dim array4 As Variant

Dim i As Long

array0 = Array("#G126A", "#G156A", "#G186B", "#GA265", "#GH264A")

For i = LBound(array0) To UBound(array0)
    If InStr(olItem.Subject, array0(i)) Then
        Exit Sub
    End If
Next

array1 = Array("100001", "103401", "108401")
For i = LBound(array1) To UBound(array1)
    If InStr(olItem.Subject, array1(i)) Then
        olItem.categories = "CAT1"
        Exit For
    End If
Next

array2 = Array("800880", "221315", "004083")
For i = LBound(array2) To UBound(array2)
    If InStr(olItem.Subject, array2(i)) Then
        olItem.categories = olItem.categories & "; " & "CAT2"
        Exit For
    End If
Next

array3 = Array("215007", "215989", "005306")
For i = LBound(array3) To UBound(array3)
    If InStr(olItem.Subject, array3(i)) Then
        olItem.categories = olItem.categories & "; " & "CAT3"
        Exit For
    End If
Next

array4 = Array("060001", "215720", "030001")
For i = LBound(array4) To UBound(array4)
    If InStr(olItem.Subject, array4(i)) Then
        olItem.categories = olItem.categories & "; " & "CAT4"
        Exit For
    End If
Next

olItem.Save

End Sub