#1
|
|||
|
|||
Filter Messages Based on Phrase with Number in Content
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. |
#2
|
||||
|
||||
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
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
Thread Tools | |
Display Modes | |
|
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 |