' File Version: 1.3
' As Of: 2/13/2026
' Latest Change: Added MoveJunk2Inbox() - this process moves Unread email in the Junk Email folder to the Inbox for processing.
'		 Also updated ThisOutlookSession file to detect when new spam email arrives in the Junk Email folder and run process.
'
' Version: 1.2 - 2/12/2026 - Added PurgeDeletedItems() - this process deletes all Unread spam emails from the Deleted Items email folder.
' Version: 1.1 - 2/2/2026 - Added ParseDomain() - this parses the sender domain if it contains one or more sub-domains.
'			    Updated GetSenderDomain() - added senderDomain = ParseDomain(senderDomain) 
' Version: 1.0 - 2/1/2026 - Initial spam filter version.

Sub CheckInbox()

Call ProcessSpamEmails
MsgBox ("Spam Filtering Process Completed")

End Sub

Sub ProcessSpamEmails()

' This function checks for any unread email in Inbox.
    Dim ol As Outlook.Application
    Set ol = New Outlook.Application
    Dim olNs As Outlook.NameSpace
    Set olNs = ol.GetNamespace("MAPI")
    Dim folder As Outlook.MAPIFolder
    Dim destFolder As Outlook.MAPIFolder
    Set folder = olNs.GetDefaultFolder(olFolderInbox) ' Source folder to check for spam.
    Set destFolder = olNs.GetDefaultFolder(olFolderDeletedItems) ' Destination folder for spam.
    
    Dim allItems As Items
    Dim unreadOnly As Items
    
    Dim sender As String
    Dim senderDomain As String
    Dim mail As Outlook.MailItem
    Dim emailCount As Long
    
    If folder.UnReadItemCount <> 0 Then
        Set allItems = folder.Items
        Set unreadOnly = allItems.Restrict("[UnRead] = True") ' Only process unread emails.
        
        For emailCount = unreadOnly.Count To 1 Step -1
            If TypeName(unreadOnly(emailCount)) = "MailItem" Then
                Set mail = unreadOnly(emailCount)
                sender = mail.SenderEmailAddress
                ' Get sender email domain.
                senderDomain = GetSenderDomain(sender)
                ' Check if senderDomain is in spamDomainsList.txt file.
                ' If on list, delete email.
                If CheckExistingDomain(senderDomain) = True Then
                    ' Delete spam email.
                    mail.Delete
                End If
            End If
        Next emailCount
    End If
    
    Call ProcessBadEmailFolder

End Sub

Private Function ProcessBadEmailFolder()
' This function adds a new spam domain from the BadEmail Outlook folder
' to the domainList.txt file.
Dim ol As Outlook.Application
Set ol = New Outlook.Application
Dim olNs As Outlook.NameSpace
Set olNs = ol.GetNamespace("MAPI")

Dim badFolder As Outlook.MAPIFolder
Dim badDestFolder As Outlook.MAPIFolder
Set badFolder = olNs.Folders("your_Outlook_email").Folders("BadEmail") ' Replace your_Outlook_email with your actual Outlook email address.
Set badDestFolder = olNs.GetDefaultFolder(olFolderDeletedItems) ' Destination for spam email.
Dim badMail As Outlook.MailItem
Dim badEmailCount As Long

For badEmailCount = badFolder.Items.Count To 1 Step -1
    If TypeName(badFolder.Items(badEmailCount)) = "MailItem" Then
        Set badMail = badFolder.Items(badEmailCount)
        sender = badMail.SenderEmailAddress
        ' Get sender domain.
        senderDomain = GetSenderDomain(sender)
        ' First check if senderDomain is in the excludeList,
        ' then check if senderDomain is in spamDomainsList.txt file.
        Dim excludeList As String
        excludeList = "gmail.com, outlook.com" ' Sender Domains to be excluded from spam filtering.
        If InStr(excludeList, senderDomain) = 0 Then
            ' If in spamDomainsList.txt file, delete email.
            If CheckExistingDomain(senderDomain) = True Then
                ' Delete email.
                badMail.Delete
            Else 'End If
            ' If senderDomain is not in the spamDomainsList.txt file, add it.
                Call AddSpamDomain(senderDomain)
                ' After domain added to list, move email to Deleted Items folder.
                badMail.Move badDestFolder
            End If
        End If
    End If
    
Next badEmailCount

' Sort all entries in spamDomainsList.txt file alphabetically.
    Call SortAlphabetically
' To disable PurgeDeletedItems process, add ' in front of the Call statement: ' Call PurgeDeletedItems
    Call PurgeDeletedItems

End Function

Private Function GetSenderDomain(ByVal sender As String) As String
' This function returns the sender domain (e.g.: @domain.com)
    Dim senderDomain
    senderDomain = "@none.com"
    Dim separator
    separator = "@"
    Dim separatorIndex As Integer
    separatorIndex = InStr(1, sender, separator)
    
    If Len(sender) > 0 Then
        If separatorIndex >= 0 Then
            senderDomain = LCase(Right(sender, (Len(sender) - separatorIndex)))
            'MsgBox ("Sender Domain: " & senderDomain) ' *** FOR TESTING ONLY ***
	    ' Parse senderDomain if more than one '.' is present.
            senderDomain = ParseDomain(senderDomain)
        End If
    End If
    
    GetSenderDomain = senderDomain

End Function

Private Function ParseDomain(ByVal tempDomain As String) As String
Dim c As Integer
Dim i As Integer
Dim searchStr As String
Dim domain As String
searchStr = "."

c = UBound(Split(tempDomain, searchStr)) ' Counts number of instances

domain = tempDomain
' Domain contains multiple instances of '.' Parse until domain is formatted as .????.com
While c > 1
    i = InStr(domain, searchStr)
    If c = 2 Then ' Only two instances of '.' remain. End process after this loop.
        i = (i - 1) ' Subtract 1 from i value in order to retain the leading '.' in domain.
        domain = Right(domain, (Len(domain) - i))
        c = 1 ' Set c = 1 to kill While loop.
    Else
        domain = Right(domain, (Len(domain) - i))
        c = UBound(Split(domain, searchStr))
    End If
Wend

ParseDomain = domain

End Function

Private Function AddSpamDomain(ByVal sDomain As String)

' Sender domain not already in the spamDomainsList.txt file.
Dim textFile As Integer
Dim filePath As String

' Path to spamList.txt file.
    filePath = "C:\_spam_domains\spamDomainsList.txt"
' Determine next file number available for use by the FileOpen function.
    textFile = FreeFile
' Open the text file.
    Open filePath For Append As textFile
    
' New text to append to existing file.
    Print #textFile, sDomain
' Save and Close text file.
    Close textFile

End Function

Private Function LoadSpamDomains() As String
' This function returns a list of all spam domains
' in the spmDomainsList.txt file as an Array.

Dim textFile As Integer
Dim filePath As String
Dim fileContent As String
Dim lineArray() As String
Dim spamList As String

' Path to spamList.txt file.
    filePath = "C:\_spam_domains\spamDomainsList.txt"
' Open the text file as read-only.
    textFile = FreeFile
    Open filePath For Input As FreeFile
' Store file content inside a variable.
    fileContent = Input(LOF(textFile), textFile)
' Close text file.
    Close textFile
' Separate out lines of text (vbCrLf = Page Break).
    lineArray() = Split(fileContent, vbCrLf)
    spamList = Join(lineArray, ", ")
' Remove any trailing comma from array. (",")
    If Right(spamList, 1) = "," Then
        spamList = Left(spamList, Len(spamList) - 1)
    End If
    LoadSpamDomains = spamList

End Function

Private Function CheckExistingDomain(ByVal sDomain As String) As Boolean
' This function checks if the sender domain (@domain.com)
' is already in the spamDomainsList.txt file.
Dim senderDomain
senderDomain = Replace(LCase(sDomain), "'", "''")

Dim spamList
spamList = LoadSpamDomains

CheckExistingDomain = False

Dim i As Long
Dim spam As String

spamList = Split(spamList, ",")
    For i = 0 To UBound(spamList) - 1
        spam = LTrim(RTrim(spamList(i)))
        ' This If statement compares the received email Domain against the current spam list.
        ' Syntax reads: is the spam list item 'spam' (.ac.ma) in the received email domain 'sDomain' (bogus.ac.ma)?
        If InStr(1, sDomain, spam, vbTextCompare) > 0 Then
            CheckExistingDomain = True
        End If
    Next i

End Function

Private Function SortAlphabetically()

    Dim spamArray As Variant
    Dim x As Long
    Dim y As Long
    Dim tempTxt1 As String
    Dim tempTxt2 As String
    
    spamArray = LoadSpamDomains
    spamArray = Split(spamArray, ",")
    
' Delete all existing content in spamDomainsList.txt file.
    'Dim textFile As Integer
    Dim filePath As String
' Path to spamList.txt file.
    filePath = "C:\_spam_domains\spamDomainsList.txt"
' Delete all content in file.
    Open filePath For Output As #1: Close #1
    
    For x = LBound(spamArray) To UBound(spamArray)
        For y = x To UBound(spamArray)
            If LCase(spamArray(y)) < LCase(spamArray(x)) Then
                tempTxt1 = spamArray(x)
                tempTxt2 = spamArray(y)
                spamArray(x) = tempTxt2
                spamArray(y) = tempTxt1
            End If
        Next y
    Next x
    
    Dim i As Long
    Dim spam As String

    For i = 0 To UBound(spamArray)
        If i >= 1 Then
            spam = LTrim(RTrim(spamArray(i)))
            Call AddSpamDomain(spam)
        End If
    Next i

End Function

Sub PurgeDeletedItems()

' This routine deletes all Unread spam in the Deleted Items email folder.
    Dim ol As Outlook.Application
    Set ol = New Outlook.Application
    Dim olNs As Outlook.NameSpace
    Set olNs = ol.GetNamespace("MAPI")
    Dim folder As Outlook.MAPIFolder
    Set folder = olNs.GetDefaultFolder(olFolderDeletedItems)
    
    Dim allItems As Items
    Dim unreadOnly As Items
    
    Dim sender As String
    Dim senderDomain As String
    Dim mail As Outlook.MailItem
    Dim emailCount As Long
    
    If folder.UnReadItemCount <> 0 Then
        Set allItems = folder.Items
        Set unreadOnly = allItems.Restrict("[UnRead] = True") ' Only process unread emails.
        
        For emailCount = unreadOnly.Count To 1 Step -1
            If TypeName(unreadOnly(emailCount)) = "MailItem" Then
                Set mail = unreadOnly(emailCount)
                sender = mail.SenderEmailAddress
                ' Get sender email domain.
                senderDomain = GetSenderDomain(sender)
                ' Check if senderDomain is in spamDomainsList.txt file.
                ' If on list, delete email.
                If CheckExistingDomain(senderDomain) = True Then
                    ' Delete spam email.
                    mail.Delete
                End If
            End If
        Next emailCount
    End If

End Sub

Sub MoveJunk2Inbox()
' This routine moves email from the Junk Email folder to the Inbox for processing.
    On Error Resume Next
    Set oOutlook = CreateObject("Outlook.Application")
    Set oNamespace = oOutlook.GetNamespace("MAPI")
    Set oFolderSrc = oNamespace.GetDefaultFolder(olFolderJunk)
    Set oFolderDst = oNamespace.GetDefaultFolder(olFolderInbox)
    Set oFilteredItems = oFolderSrc.Items
    For Each oMessage In oFilteredItems
        oMessage.Move oFolderDst
    Next
End Sub

Sub CountSpamDomains()
' This function returns a list of all spam domains
' in the spamDomainsList.txt file as an Array.

Dim textFile As Integer
Dim filePath As String
Dim fileContent As String
Dim lineArray() As String
Dim spamList As String
Dim txtLine As String

' Path to spamList.txt file.
    filePath = "C:\_spam_domains\spamDomainsList.txt"
' Open the text file as read-only.
    textFile = FreeFile
    Open filePath For Input As FreeFile
' Store file content inside a variable.
    fileContent = Input(LOF(textFile), textFile)
' Close text file.
    Close textFile
' Separate out lines of text (vbCrLf = Page Break).
    lineArray() = Split(fileContent, vbCrLf)
    spamList = Join(lineArray, ", ")
' Displays content of the domainList.txt file.
'    MsgBox (spamList) ' *** FOR TESTING ONLY ***
' Display how many total spam domain entries are in the text file. *** FOR INFORMATIONAL PURPOSES ONLY ***
    MsgBox ("There are " & UBound(lineArray) + 1 & " spam domains in the spamDomainList.txt file.")

End Sub