How to find the first incident of any signature in a list/array within an email?

Question

I want to give credit to an agent, if they're the one that sent the message, but only if their signature is at the top of the email.

Here is what I have. The search order is off. The code searches for one name at a time, and clear through the document. I need it to search for All names, the first one that hits in the body of the email.

Sub CountOccurences_SpecificText_In_Folder()
    Dim MailItem As Outlook.MailItem
    Dim strSpecificText As String
    Dim tmpStr As String
    Dim x As Integer
    Dim Count As Integer
    
    Dim HunterCnt As Integer
    Dim SunmolaCnt As Integer
    Dim RodriguezCnt As Integer
    Dim MammedatyCnt As Integer
    Dim MitchellCnt As Integer
    Dim TannerCnt As Integer
    Dim TAYLORCnt As Integer
    Dim WilsonCnt As Integer
    Dim WilliamsCnt As Integer
    Dim GrooverCnt As Integer
    Dim TyreeCnt As Integer
    Dim ChapmanCnt As Integer
    Dim LukerCnt As Integer
    Dim KlinedinstCnt As Integer
    Dim HicksCnt As Integer
    Dim NATHANIALCnt As Integer
    Dim SkinnerCnt As Integer
    Dim SimonsCnt As Integer
    
   
    
    Dim AgentNames(14) As Variant
    AgentNames(0) = "Simons"
    AgentNames(1) = "Skinner"
    AgentNames(2) = "Mammedaty"
    AgentNames(3) = "Hunter"
    AgentNames(4) = "Sunmola"
    AgentNames(5) = "Rodriguez"
    AgentNames(6) = "Mitchell"
    AgentNames(7) = "Tanner"
    AgentNames(8) = "Taylor"
    AgentNames(9) = "Wilson"
    AgentNames(10) = "Williams"
    AgentNames(11) = "Groover"
    AgentNames(12) = "Tyree"
    AgentNames(13) = "Chapman"
    AgentNames(14) = "Luker"


x = 0
While x < ActiveExplorer.Selection.Count


    x = x + 1
    Set MailItem = ActiveExplorer.Selection.item(x)
        tmpStr = MailItem.Body
        
    For Each Agent In AgentNames
        If InStr(tmpStr, Agent) <> 0 Then
           If Agent = "Assunta" Then
              HunterCnt = HunterCnt + 1
              GoTo skip
           End If
           If Agent = "Sunmola" Then
              SunmolaCnt = SunmolaCnt + 1
              GoTo skip
           End If
           If Agent = "Rodriguez" Then
              RodriguezCnt = RodriguezCnt + 1
              GoTo skip
           End If
           
           If Agent = "Mammedaty" Then
              MammedatyCnt = MammedatyCnt + 1
              GoTo skip
           End If
           
           If Agent = "Mitchell" Then
              MitchellCnt = MitchellCnt + 1
              GoTo skip
           End If
           
           If Agent = "Tanner" Then
              TannerCnt = TannerCnt + 1
              GoTo skip
           End If
           
           If Agent = "Taylor" Then
              TAYLORCnt = TAYLORCnt + 1
              GoTo skip
           End If
           
           If Agent = "Wilson" Then
              WilsonCnt = WilsonCnt + 1
              GoTo skip
           End If
           
           If Agent = "Williams" Then
              WilliamsCnt = WilliamsCnt + 1
              GoTo skip
           End If
           
           If Agent = "Groover" Then
              GrooverCnt = GrooverCnt + 1
              GoTo skip
           End If
           
           If Agent = "Tyree" Then
              TyreeCnt = TyreeCnt + 1
              GoTo skip
           End If
           
           If Agent = "Chapman" Then
              ChapmanCnt = ChapmanCnt + 1
              GoTo skip
           End If
           
           If Agent = "Luker" Then
              LukerCnt = LukerCnt + 1
              GoTo skip
           End If
           
           
           
           If Agent = "Hicks" Then
              HicksCnt = HicksCnt + 1
              GoTo skip
           End If
           
           
           
        End If
    Next
 skip:
    Count = Count + 1
    Wend
    MsgBox "Found " & vbCrLf & "Hunter Count: " & HunterCnt & vbCrLf & "Sunmola Count: " & SunmolaCnt & vbCrLf & "Rodriguez Count: " & RodriguezCnt & vbCrLf & "Mammedaty Count: " & MammedatyCnt & vbCrLf & "Mitchell Count: " & MitchellCnt & vbCrLf & "Tanner Count: " & TannerCnt & vbCrLf & "Taylor Count: " & TAYLORCnt & vbCrLf & "Wilson Count: " & WilsonCnt & vbCrLf & "Williams Count: " & WilliamsCnt & vbCrLf & "Groover Count: " & GrooverCnt & vbCrLf & "Tyree Count: " & TyreeCnt & vbCrLf & "Chapman Count: " & ChapmanCnt & vbCrLf & "Luker Count: " & LukerCnt & vbCrLf & " in: " & Count & " emails"

End Sub

score 0 · Answer 1 · answered Nov 18 '20 at 15:15

InStr returns positional information. While it is difficult to find the first occurrence of an array member within the text (you would need to build and compare matches), you can find the first position of each name then find which came first.

For example (untested)

Sub CountOccurences_SpecificText_In_Folder()
    Dim MailItem As Outlook.MailItem
    Dim i As Long, x As Long, position As Long, First As Long
        
    Dim AgentNames() As String
    AgentNames = Split("Simons,Skinner,Mammedaty,Hunter,Sunmola,Rodriguez,Mitchell,Tanner,Taylor,Wilson,Williams,Groover,Tyree,Chapman,Luker", ",")
    
    Dim AgentCount(LBound(AgentNames) To UBound(AgentNames)) As Long
    For i = LBound(AgentCount) To UBound(AgentCount)
        AgentCount(i) = 0
    Next i

    For Each MailItem In ActiveExplorer.Selection
        x = 0
        For i = LBound(AgentNames) To UBound(AgentNames)
            position = InStr(MailItem.Body, AgentNames(i))
            If x > 0 Then
                If position < x Then
                    x = position
                    First = i
                End If
            Else
                If position > 0 Then
                    x = position
                    First = i
                End If
            End If
        Next i
        AgentCount(First) = AgentCount(First) + 1
    Next MailItem

    For i = LBound(AgentNames) To UBound(AgentNames)
        Debug.Print AgentNames(i) & " Count: " & AgentCount(i)
    Next i
    
End Sub

niton · Answer 2 · 2022-02-13T16:27:30.067

The idea in the previous answer may be better implemented like this:

Option Explicit

Sub CountOccurences_SpecificText_SelectedItems()

    Dim objItem As Object
    Dim objMail As MailItem
    
    Dim i As Long
    Dim j As Long
    
    Dim x As Long
    Dim position As Long
    Dim First As Long
    
    Dim AgentNames() As String
    AgentNames = Split("Simons,Skinner,Mammedaty,Hunter,Sunmola,Rodriguez,Mitchell,Tanner,Taylor,Wilson,Williams,Groover,Tyree,Chapman,Luker", ",")
    
    ReDim AgentCount(LBound(AgentNames) To UBound(AgentNames)) As Long
    
    For j = 1 To ActiveExplorer.Selection.Count
    
        Set objItem = ActiveExplorer.Selection(j)
        
        ' Verify before attempting to return mailitem poroperties
        If TypeOf objItem Is MailItem Then
        
            Set objMail = objItem
            Debug.Print
            Debug.Print "objMail.Subject: " & objMail.Subject
            
            x = Len(objMail.Body)
            
            For i = LBound(AgentNames) To UBound(AgentNames)
            
                Debug.Print
                Debug.Print "AgentNames(i): " & AgentNames(i)
                position = InStr(objMail.Body, AgentNames(i))
                Debug.Print "       position: " & position
                
                If position > 0 Then
                    If position < x Then
                        x = position
                        First = i
                    End If
                End If
                
                Debug.Print "Lowest position: " & x
                Debug.Print "  Current first: " & AgentNames(First)
                
            Next i
            
            If x < Len(objMail.Body) Then
            
                AgentCount(First) = AgentCount(First) + 1
                Debug.Print
                Debug.Print AgentNames(First) & " was found first"
                
            Else
                Debug.Print "No agent found."
                
            End If
            
        End If
    Next

    For i = LBound(AgentNames) To UBound(AgentNames)
        Debug.Print AgentNames(i) & " Count: " & AgentCount(i)
    Next i
    
End Sub

How to find the first incident of any signature in a list/array within an email?

2 Answers2