Filter Messages Based on Phrase with Number in Content

damaniam · #1 02-02-2021, 08:39 AM

So every day I get an email and it contains the phrase "Total Scrubbed Deferred: X". X represents any integer. The phrase may appear more than once in the same email, but not more than twice.

My objective is to have the emails that are received where X is = 0 simply be marked as read. For those where X is > 0 receive an alert window with whatever that day's phrase is. For example, if today's email reference "Total Scrubbed Deferred: 2" and further down "Total Scrubbed Deferred: 1", the alert window would show "Total Scrubbed Deferred: 2" "Total Scrubbed Deferred: 1".

I apologize if this is something that has already been answered and if so, I would appreciate someone pointing me in the correct direction of the solution. If this is a new question, thanks in advance to anyone for your assistance.

gmayor · #2 02-02-2021, 11:24 PM

You need a script in conjunction with a rule that identifies the incoming messages e.g. as follows. Use the test macro with an existing message to test the script.

Code:

Option Explicit

Sub TestScrubbed()
Dim olMsg As MailItem
    On Error Resume Next
    Select Case Outlook.Application.ActiveWindow.Class
        Case olInspector
            Set olMsg = ActiveInspector.currentItem
        Case olExplorer
            Set olMsg = Application.ActiveExplorer.Selection.Item(1)
    End Select
    CheckScrubbed olMsg
lbl_Exit:
    Exit Sub
End Sub

Sub CheckScrubbed(olItem As MailItem)
'Graham Mayor - https://www.gmayor.com - Last updated - 03 Feb 2021
Const strFind As String = "Total Scrubbed Deferred: "
Dim olInsp As Inspector
Dim wdDoc As Object
Dim oRng As Object
Dim sText As String
Dim sMsg As String
Dim i As Integer
Dim oCol As Collection
    With olItem
        Set oCol = New Collection
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range
        With oRng.Find
            Do While .Execute(findText:=strFind & "[0-9]{1,}", MatchWildcards:=True)
                sText = Replace(oRng.Text, strFind, "")
                Select Case True
                    Case CInt(sText) = 0
                        olItem.UnRead = False
                    Case CInt(sText) > 0
                        On Error Resume Next
                        oCol.Add oRng.Text, oRng.Text
                End Select
                .collapse 0
            Loop
            If oCol.Count > 0 Then
                olItem.UnRead = True
                For i = 1 To oCol.Count
                    If i = 1 Then sMsg = oCol(i)
                    If i > 1 Then sMsg = sMsg & vbCr & oCol(i)
                Next i
                MsgBox sMsg, vbExclamation
            End If
        End With
    End With
lbl_Exit:
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
    Exit Sub
End Sub

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
How to modify code for Auto filter based on two criteria ...	LearnerExcel	Excel Programming	13	02-14-2018 08:20 PM
count a number of cells based on the beginning of a order number	Kubi	Excel	2	08-06-2017 08:54 PM
Filter Mail Merge based on a list of filter criteria	AusSteelMan	Mail Merge	2	05-09-2016 03:35 PM
Creating a plain text content control for every instance of a word or phrase	RobsterCraw	Word VBA	16	11-20-2012 03:25 PM
Is there a way to print based on a particular filter?	Jamal NUMAN	Excel	4	03-20-2012 11:32 AM