Outlook Rules - Alternative to wildcards - vba

Question

Every day I get one or more spam emails of a very specific type to my xxxxx#gmail account.
They all have a garbled and unique FROM: email address.
The TO: and CC: fields are always of the form xxxxx[random chars]#aol.com. For example I got one today with
TO: xxxxx#aol.com
CC: xxxxxY7#aol.com
I would like to create a rule to automatically send these to spam and block. Two possible conditionals would be:
"with xxxxx AND #aol.com in recipient's address"
"with xxxxx*#aol.com in recipient's address" (with * as a wildcard).
#1 doesnt work because the "specific words" it requests are concatenated with OR, no option to use AND.
#2 doesn't work because as far as I can tell there is no way to use wildcards.
Any suggestions? I realize there probably is a straightforward VBA script solution but I haven't played with VBA in over a decade. Was hoping there might be another clever non-VBA work around. Thanks.

Answer 1

There is no workaround. You can handle incoming emails in Outlook VBA by handling the NewMailEx event of the Application class. This event fires once for every received item that is processed by Microsoft Outlook. The item can be one of several different item types, for example, MailItem, MeetingItem, or SharingItem. The EntryIDsCollection string contains the Entry ID that corresponds to that item. You can use the Entry ID from the EntryIDCollection parameter to call the NameSpace.GetItemFromID method and process the item.
In the NewMailEx event handler you can check the required properties such as Recipients and etc. and move the item wherever you need.

Answer 2

As stated, NewMailEx can be used to handle some filtering like this and I have a regex filter that I use as standard automatic rules don't allow that (or at least not currently - maybe a future upgrade). If you can use a regex to identify the e-mails you want to process then you could use this code:
In ThisOutlookSession
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
On Error Resume Next
Call RegExFilterRules(EntryIDCollection)
End Sub
In a module
Sub RegExFilterRules(ItemID As String)
With Application.GetNamespace("MAPI")
Dim Inbox As Outlook.MAPIFolder: Set Inbox = .GetDefaultFolder(olFolderInbox)
Dim Junk As Outlook.MAPIFolder: Set Junk = .GetDefaultFolder(olFolderJunk)
Dim olItem As Outlook.MailItem: Set olItem = .GetItemFromID(ItemID, Inbox.StoreID)
End With
'On Error Resume Next
If Not olItem Is Nothing And olItem.Class = olMail Then
If IsPatternFound(olItem.subject, "^M\d+$") Then olItem.Move Junk 'olItem.Delete 'olItem.UnRead = False
If olItem.Sender = "cortana#microsoft.com" Then olItem.Delete
End If
Set olItem = Nothing
End Sub
Private Function IsPatternFound(Content As String, Pattern As String) As Boolean
' Requires Reference: Microsoft Scripting Runtime
Dim RegEx As Object: Set RegEx = CreateObject("vbscript.RegExp")
With RegEx
.Global = True
.IgnoreCase = True
.MultiLine = True
.Pattern = Pattern
IsPatternFound = .Test(Content)
End With
End Function