I see quite a few requests for help like this:

I'm receiving constant spam emails from a specific top-level domain. No legitimate sender I am in contact with would use this TLD and I would like to delete every single message from email addresses in this domain. The problem: they are snagged by the Junk folder, so any rules won't work. I can't effectively browse the Junk Email folder to see if any legitimate emails are in there, because I'm swamped with the spam.

Correct, rules won't work on mail if the junk email filter grabs it first, but you can run the rules on the Junk Email folder when you use Outlook desktop software.

1. Add the Run Rules Now command to the Quick Access Toolbar or ribbon
   
2. Select the Junk Email folder
3. Click Run Rules Now button you added to the QAT or ribbon
4. Select the Rule
5. Click Run Now
   

You can also use an ItemAdd macro to watch the Junk Email folder and delete mail as it is added to the Junk Mail folder.

Use an ItemAdd macro

This simple macro watches the default Junk Email folder for messages from one top-level domain.

Notes: As written, these macros only work on the default junk email folder. If you have more than one data file, you'd need to watch each Junk Email folder. Or use the macro at the end of the page to run the ItemAdd macro on any folder in your profile. Also, the macro moves the junk mail to the Deleted items folder. VBA doesn't have a permanently delete command, so w need to move it to the Deleted Items and would need to delete it again.

Option Explicit
Private objNS As Outlook.NameSpace
Private WithEvents objItems As Outlook.Items

Private Sub Application_Startup()
 
Dim objWatchFolder As Outlook.Folder
Set objNS = Application.GetNamespace("MAPI")

'Set the folder and items to watch:
Set objWatchFolder = objNS.GetDefaultFolder(olFolderJunk)
Set objItems = objWatchFolder.Items

Set objWatchFolder = Nothing
End Sub

' ### ItemAdd macro
Private Sub objItems_ItemAdd(ByVal Item As Object)
Debug.Print Item.SenderEmailAddress

' change the TLD and the count 
If Right(Item.SenderEmailAddress, 3) = ".br" Then
  Item.Delete
End If

Set Item = Nothing
End Sub
' ### End ItemAdd macro

To watch for multiple top-level domains in the default Junk Email folder, we'll use select case and an array. This allows us to check for TLDs of different lengths.

For the array, you'll use a comma-separated list of domains. If you want to delete longer TLDs (such as .trade), add another case block, where the Case value is the length of the TLD + 1 (for the .)

Option Explicit
Private objNS As Outlook.NameSpace
Private WithEvents objItems As Outlook.Items

Private Sub Application_Startup()
 
Dim objWatchFolder As Outlook.Folder
Set objNS = Application.GetNamespace("MAPI")

'Set the folder and items to watch:
Set objWatchFolder = objNS.GetDefaultFolder(olFolderJunk)
Set objItems = objWatchFolder.Items

Set objWatchFolder = Nothing
End Sub

 ' ## multi-TLD ItemAdd macro
Private Sub objItems_ItemAdd(ByVal Item As Object)
Dim arrTLD 'As variant
Dim lenTLD As Long
Dim i As Long

'Debug.Print Item.SenderEmailAddress
'Debug.Print InStrRev(Item.SenderEmailAddress, ".")

lenTLD = Len(Item.SenderEmailAddress) - InStrRev(Item.SenderEmailAddress, ".") + 1
'Debug.Print lenTLD

Select Case lenTLD
Case 3
  arrTLD = Array(".de", ".br", ".gq", ".tk", ".ga", ".it", ".tr", ".ml")
GoTo checkdomain

Case 4
  arrTLD = Array(".org", ".xyz")
GoTo checkdomain

Case 5
  arrTLD = Array(".live", ".club")
GoTo checkdomain

Case Else ' avoids errors a longer TLD is found
    Exit Sub

End Select

checkdomain:
Debug.Print lenTLD, Right(LCase(Item.SenderEmailAddress), lenTLD)
' Go through the array and look for a match, then do something
For i = LBound(arrTLD) To UBound(arrTLD)
    If Right(LCase(Item.SenderEmailAddress), lenTLD) = arrTLD(i) Then
    Item.Delete
    Exit Sub
    End If
Next i

Set Item = Nothing
End Sub

' ## End  multi-TLD ItemAdd macro

Watch folders in another data file

The macros above watch the Junk Email folder in your default data file. To watch the folder in another data file, you need to use the GetFolderPath function. To use it with Shared Exchange mailboxes, you need to use the shared mailbox code instead.

Option Explicit
Private objNS As Outlook.NameSpace
Private WithEvents objItems As Outlook.Items

Private Sub Application_Startup()
 
Dim objWatchFolder As Outlook.Folder
Set objNS = Application.GetNamespace("MAPI")

'Set the folder and items to watch:
' Set objWatchFolder = objNS.GetDefaultFolder(olFolderJunk)
Set objWatchFolder = GetFolderPath("Outlook Data File\Junk Email")

Set objItems = objWatchFolder.Items

Set objWatchFolder = Nothing
End Sub

'### this can be replaced with the multi-TLD ItemAdd macro

Private Sub objItems_ItemAdd(ByVal Item As Object)
Debug.Print Item.SenderEmailAddress

' change the TLD and the count 
If Right(Item.SenderEmailAddress, 3) = ".br" Then
  Item.Delete
End If

Set Item = Nothing
End Sub

' ### End ItemAdd

' from https://slipstick.me/qf
Function GetFolderPath(ByVal FolderPath As String) As Outlook.Folder
    Dim oFolder As Outlook.Folder
    Dim FoldersArray As Variant
    Dim i As Integer
        
    On Error GoTo GetFolderPath_Error
    If Left(FolderPath, 2) = "\\" Then
        FolderPath = Right(FolderPath, Len(FolderPath) - 2)
    End If
    'Convert folderpath to array
    FoldersArray = Split(FolderPath, "\")
    Set oFolder = Application.Session.Folders.Item(FoldersArray(0))
    If Not oFolder Is Nothing Then
        For i = 1 To UBound(FoldersArray, 1)
            Dim SubFolders As Outlook.Folders
            Set SubFolders = oFolder.Folders
            Set oFolder = SubFolders.Item(FoldersArray(i))
            If oFolder Is Nothing Then
                Set GetFolderPath = Nothing
            End If
        Next
    End If
    'Return the oFolder
    Set GetFolderPath = oFolder
    Exit Function
        
GetFolderPath_Error:
    Set GetFolderPath = Nothing
    Exit Function
End Function

How to use the macros on this page

First: You need to have macro security set to the lowest setting, Enable all macros during testing. The macros will not work with the top two options that disable all macros or unsigned macros. You could choose the option Notification for all macros, then accept it each time you restart Outlook, however, because it's somewhat hard to sneak macros into Outlook (unlike in Word and Excel), allowing all macros is safe, especially during the testing phase. You can sign the macro when it is finished and change the macro security to notify.

To check your macro security in Outlook 2010 and newer, go to File, Options, Trust Center and open Trust Center Settings, and change the Macro Settings. In Outlook 2007 and older, look at Tools, Macro Security.

After you test the macro and see that it works, you can either leave macro security set to low or sign the macro.

Macros that run when Outlook starts or automatically need to be in ThisOutlookSession, all other macros should be put in a module, but most will also work if placed in ThisOutlookSession. (It's generally recommended to keep only the automatic macros in ThisOutlookSession and use modules for all other macros.) The instructions are below.

The macros on this page need to go into ThisOutlookSession.

Open the VBA Editor by pressing Alt+F11 on your keyboard.

To put the macro code in ThisOutlookSession:

1. Expand Project1 and double click on ThisOutlookSession.
2. Copy then paste the macro into ThisOutlookSession. (Click within the code, Select All using Ctrl+A, Ctrl+C to copy, Ctrl+V to paste.)

More information as well as screenshots are at How to use the VBA Editor

How to test an ItemAdd macro

To test an ItemAdd macro, you can either copy and paste one or more junk emails in place (Ctrl+C,V) or move mail into the folder you are watching. Or add the macro below at the end of ThisOutlookSession, then select a message and run the macro.

Sub RunScript()
  Dim objApp As Outlook.Application
  Dim objItem As MailItem
  Set objApp = Application
  Set objItem = objApp.ActiveExplorer.Selection.Item(1)

   'macro name you want to run goes here
    objItems_ItemAdd objItem
End Sub

 
To run either ItemAdd macro on all messages in any folder, use this macro call to call the ItemAdd macro.

Public Sub RunonAnyFolder()
    Dim objOL As Outlook.Application
    Dim objItems As Outlook.Items
    Dim objFolder As Outlook.MAPIFolder
    Dim obj As Object
    Dim i As Long
 
    Set objOL = Outlook.Application
    Set objFolder = objOL.ActiveExplorer.CurrentFolder
    Set objItems = objFolder.Items
 
    For i = objItems.Count To 1 Step -1
    Set obj = objItems(i)
     'macro name you want to run goes here
     objItems_ItemAdd obj
    Next
 
    Set obj = Nothing
    Set objItems = Nothing
    Set objFolder = Nothing
    Set objOL = Nothing
End Sub