Consulting

Results 1 to 3 of 3

Thread: Outlook - VBA Script to Identify Messages with Excessive Content

  1. #1
    VBAX Regular
    Joined
    Jun 2007
    Posts
    12
    Location

    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.
    Screen Shot 2019-04-19 at 8.59.02 AM.jpg

    Thanks!
    Attached Images Attached Images
    Last edited by lneidorf; 04-19-2019 at 06:00 AM.

  2. #2
    Thank you, that's helpful.

  3. #3
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,158
    Location
    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
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved

    Excel 365, Version 2401, Build 17231.20084

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •