Outlook - VBA Script to Identify Messages with Excessive Content

[lneidorf]

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.
24104

Thanks!

[meadlobon]

Thank you, that's helpful.

[georgiboy]

Are you doing this inside Outlook?

If so then the below may help:


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