Outlook VBA to Move Spam from Top Level Domains to Junk

There is a spammer who has been active for the last couple of months. The majority of my spam email has been coming from the top level domains .trade, .bid, .club, .stream, and .date. I get no legitimate mail from any of those top level domains.

I wrote a VBA routine to go through my inbox and move all email from those domains to my junk folder. It appears below:

Public Sub JunkSpamDomains()
    On Error GoTo ErrorHandler
    Dim mailItem As Outlook.mailItem
    Dim folderInbox As Outlook.folder
    Dim folderJunk As Outlook.folder
    Dim i As Long
    Dim accessor As Outlook.PropertyAccessor
    Dim strHeaders As String
    Dim lngOffset1 As Long
    Dim lngOffset2 As Long
    Dim lngDomainOffset As Long
    Dim strFrom As String
    Dim strDomain As String

    Const PR_TRANSPORT_MESSAGE_HEADERS = "http://schemas.microsoft.com/mapi/proptag/0x007D001E"    Const strBanned As String = ".trade|.bid|.club|.stream|.date"

    Set folderInbox = Application.Session.GetDefaultFolder(olFolderInbox)
    Set folderJunk = Application.Session.GetDefaultFolder(olFolderJunk)
    For Each mailItem In folderInbox.Items
        If mailItem.Class = OlObjectClass.olMail Then
            Set accessor = mailItem.PropertyAccessor
            strHeaders = accessor.GetProperty(PR_TRANSPORT_MESSAGE_HEADERS)
            lngOffset1 = InStr(1, strHeaders, vbCrLf & "From: ") + 8
            lngOffset2 = InStr(lngOffset1, strHeaders, ">")
            strFrom = Mid(strHeaders, lngOffset1, lngOffset2 - lngOffset1)
            lngDomainOffset = InStrRev(strFrom, ".")
            strDomain = Mid(strFrom, lngDomainOffset)
            If InStr(1, strBanned, strDomain) > 0 Then
                mailItem.Move folderJunk
            End If
            Set accessor = Nothing
            Set mailItem = Nothing
        End If
    Next mailItem
    Set folderInbox = Nothing
    Set folderJunk = Nothing
Exit Sub
ErrorHandler:
    Select Case Err.Number
    Case Else
        MsgBox "Unexpected Error #" & Err.Number & " " & Err.Description
        Resume Next
    End Select
End Sub

Press Alt-F11 to open the VBA Editor. Select Insert Module from the menu to insert a new module. Paste this code into the window. You can bind a button on the Quick Access Toolbar (QAT) to this macro. Click the drop-down button on the right of the QAT, and select "More Commands...". Drop the "Choose Commands from:" list and select "Macros". Select "JunkSpamDomains" and click the "Add>>" button. Click the OK button.

After moving message, review the Junk folder to make sure that only spam got moved.