Outlook - VBA Script to Identify Messages with Excessive Content

I am dealing with the processing of a large amount (several TB) of Outlook PST files. Unfortunately, these PSTs contain many Bloomberg chat messages that have been stored in the PSTs as emails, with no special formatting. Some of these Bloomberg chat messages are causing processing to fail. The issue seems to be that the message BODY contains a ton of chat recipients, all separated by the pipe character ( | ). We're talking tens of thousands of recipients. And so I need a way to identify the offending messages and move them. These Bloomberg emails appear to make up at least half or more of the PSTs.

First Requirement:

• Subject contains "Bloomberg Message" OR "Bloomberg_Message"

Second Requirement:

• Identify messages where the text contains more than 210 instances of the pipe character ( | ). These present the recipients of the Bloomberg chats within the text of the messages, rather than the headers. There, we find thousands of recipients, separated by the pipe character ( | ). So counting the pipes and moving messages with more than X number seems a good solution, if possible.

For messages meeting these criteria, the goal will be to move them from whatever folder they reside in to another new folder.

Here's a sample of the message text [edited to remove personal information], which goes on to list more than 25,000 recipients. Again, this is contained in the BODY of the message, rather than the Outlook address fields.
Attachment 24104

Thanks!

Thank you, that's helpful.

Are you doing this inside Outlook?

If so then the below may help:

Code:

---

Sub MoveMailIf()   
    Dim olItem As Outlook.MailItem
    Dim myNameSpace As Outlook.NameSpace
    Dim myInbox As Outlook.MAPIFolder
    Dim dFold As Outlook.MAPIFolder
    Dim sFold As Outlook.MAPIFolder
    Dim WholeString As String, PartString As String
   
    Set myNameSpace = Application.GetNamespace("MAPI")
    Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
    Set dFold = myInbox.Folders("111AAA")
    Set sFold = myInbox.Folders("1A")
   
    For Each MailItem In sFold.Items
        Set olItem = MailItem
        WholeString = olItem.Body
        PartString = Replace(WholeString, "|", "")
        If Len(WholeString) - Len(PartString) > 210 Then
            olItem.Move dFold
        End If
    Next
   
End Sub

---

Hope this helps