Count individual message subjects

groupcount.vba

Option Explicit
Public Sub processMessages()
    Dim objOL As Outlook.Application
    Dim currentExplorer As Explorer
    Dim Selection As Selection
    Dim obj As Object
    Dim dict As Object
 
    Set objOL = Outlook.Application
    Set currentExplorer = objOL.ActiveExplorer
    Set Selection = currentExplorer.Selection
    
    Set dict = CreateObject("Scripting.Dictionary")
 
    For Each obj In Selection
 
     'Loop over every selected email
     With obj
       If dict.exists(.Subject) Then
         dict(.Subject) = dict(.Subject) + 1
       Else
         dict(.Subject) = 1
       End If
    
     End With

    Next
    
    Dim key As Variant
    For Each key In dict.Keys
      Debug.Print key, dict(key)
    Next key
 
    'Set Session = Nothing
    Set currentExplorer = Nothing
    Set obj = Nothing
    Set Selection = Nothing
End Sub