Spam Fighting Solution For 3 Synced Outlooks

[Witzker]

I want to build a Spam fighting solution for 3 Outlooks synced with SimpleSyn with this 3 or 5 macros described.

1st - Exporting sender's email address name@domain.xx to an Excel file called BlackList.xls in a public place and sync it with other Outlooks
Concerning this I found:

Private Const SenderFile As String = "C:\Users\Privat\Documents\Outlook-Dateien\BlackList\BlackList.txt"

Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _

        ByVal hwnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, _

        ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As LongPtr) As LongPtr

Public Sub ExportSenderAddresses()
  On Error GoTo ERR_HANDLER
  Dim Sel As Outlook.Selection
  Dim Addresses As String
  Dim File As String
  Dim Hnd As Long

  Set Sel = Application.ActiveExplorer.Selection

  Addresses = GetSenderAddresses(Sel)

  If Len(Addresses) Then
    Hnd = FreeFile
    Open SenderFile For Append As #Hnd
    Print #Hnd, Addresses;
    Close #Hnd

    ShellExecute 0, "open", SenderFile, "", "", 1
  End If
Exit Sub

ERR_HANDLER:
  If Hnd Then Close #Hnd
  MsgBox Err.Description
End Sub

Private Function GetSenderAddresses(Sel As Outlook.Selection) As String

  Dim b As String
  Dim obj As Object
  Dim i As Long
  For i = 1 To Sel.Count
    Set obj = Sel(i)
    If TypeOf obj Is Outlook.MailItem Or _
      TypeOf obj Is Outlook.MeetingItem Then
        b = b & obj.SenderEmailAddress & vbCrLf
   End If

  Next
  GetSenderAddresses = b
  End Function

Works - But Not using an Excel file
(I think an Excel file would be easier to sort and look for maybe wrongly added mails or domains)

2nd - Exporting sender’s @domain.xx to the same Excel file
How to modify the 1St macro exporting only domain?

3rd - Macro that puts email from a sender which is in this Excel file Blacklist.xls to Outlook’s Spam folder.

The BlckList.xls then contains the following entries.
name@domain.xx
*@domain.xx
*@*.domain.xx (Can be edited or better also be exported with a 4th macro, if possible)

5th - Macro should look into the BlackList.xls when emails are received in OL inbox.

If there is a mail "From” matching an entry in this BlackList.xls the mail should be then put into Outlook’s Spam folder.

Concerning This I found :
How to Auto Block Unwanted Outlook Emails with the Blacklist in a Text File - Data Recovery Blog (datanumen.com)

Public WithEvents objInboxFolder As Outlook.Folder

Public WithEvents objInboxItems As Outlook.Items

Public objJunkFolder As Outlook.Folder


Private Sub Application_Startup()

    Set objInboxFolder = Outlook.Application.Session.GetDefaultFolder(olFolderInbox)
    Set objInboxItems = objInboxFolder.Items
    Set objJunkFolder = Outlook.Application.Session.GetDefaultFolder(olFolderJunk)

End Sub



Private Sub objInboxItems_ItemAdd(ByVal objItem As Object)

    Dim objMail As Outlook.MailItem
    Dim strSenderEmailAddress As String
    Dim strTextFile As String
    Dim objFileSystem As Object
    Dim objTextStream As Object
    Dim objRegExp As Object
    Dim objMatches As Object
    Dim objMatch As Object
    Dim strLine As String

    If TypeName(objItem) = "MailItem" Then
       Set objMail = objItem
       strSenderEmailAddress = objMail.SenderEmailAddress

       'Change the path to the specific plain text file
       strTextFile = "C:\Users\Privat\Documents\Outlook-Dateien\BlackList\BlackList.txt"
       Set objFileSystem = CreateObject("Scripting.FileSystemObject")
       Set objTextStream = objFileSystem.OpenTextFile(strTextFile)

       'Get email addresses in the plain text file
       Set objRegExp = CreateObject("vbscript.RegExp")
       With objRegExp

            .Pattern = "(?:[a-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\.[a-z0-9!#$%&'*+/=?^_`{|}~-]+)*|""(?:[\x01-\x08\x0b\x0c\x0e-\x1f\x21\x23-\x5b\x5d-\x7f]|\[\x01-\x09\x0b\x0c\x0e-\x7f])*"")@(?:(?:[a-z0-9](?:[a-z0-9-]*[a-z0-9])?\.)+[a-z0-9](?:[a-z0-9-]*[a-z0-9])?|\[(?:(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.){3}(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?|[a-z0-9-]*[a-z0-9]:(?:[\x01-\x08\x0b\x0c\x0e-\x1f\x21-\x5a\x53-\x7f]|\[\x01-\x09\x0b\x0c\x0e-\x7f])+)\])"

            .IgnoreCase = True
            .Global = True
       End With

       Do Until objTextStream.AtEndOfStream
          strLine = objTextStream.ReadLine
          If strLine <> "" Then
             If objRegExp.test(strLine) Then
                Set objMatches = objRegExp.Execute(strLine)
                For Each objMatch In objMatches
                    If objMatch.Value = strSenderEmailAddress Then
                       objMail.Move objJunkFolder
                       Exit Do
                    End If
                Next
             End If
           End If
       Loop
    End If

End Sub

Woks - But I use a TXT file and
can only read entries like
name@domain.xx
Cannot read the entries:
*@domain.xx
*@*.domain.xx

I hope everything is clear

What do you think about this solution?