Spam Fighting Solution For 3 Synced Outlooks

Status
Not open for further replies.

Witzker

Senior Member
Outlook version
Outlook 2019 64-bit
Email Account
POP3
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:

Code:
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)

Code:
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?
 
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
Geldner Problem submitting SPAM using Outlook VBA Form Outlook VBA and Custom Forms 2
R Script for simplifying spam control Outlook VBA and Custom Forms 8
C Spam Email? Using Outlook 2
P dealing with SPAM in 2023 Using Outlook 7
J How to Block junk/spam domain Using Outlook 0
CWM550 Outlook 365 Hey Diane! MS 365 Biz Standard and "Potential Spam" addressed to others coming to my JUNK folder? Using Outlook 2
P What is your strategy for dealing with SPAM and Junk Mail? Using Outlook 1
F Email being marked as Spam by Gmail and not being visible in Outlook Using Outlook 5
Jennifer Murphy Spam filter not working Using Outlook 13
B Can I create a local PST file for SPAM on a drive that is usually disconnected? Using Outlook 3
B Spam folder not showing in Outlook Using Outlook 5
CWM550 OL Spam hold Using Outlook 4
B Outlook - Mail from safe senders list being sent to Spam Folder Using Outlook 0
P Outlook 2010 trusted emails going to spam folder Using Outlook 18
P Disable Spam Notifications & Sounds Using Outlook 3
V Spam folder not showing in Outlook Using Outlook 4
e_a_g_l_e_p_i Is there a good third party SPAM filter that intergrates with Outlook 2010 Using Outlook 7
O Outlook Web Access - how to disable spam filter Using Outlook 6
M godaddy says my outlook's sending spam. Using Outlook 4
Ascar_CT MS Outlook 2010 with Hotmail connector went spam control nuts Using Outlook.com accounts in Outlook 1
D Outlook Add-on for Exchange Spam Management? Exchange Server Administration 2
J [SPAM?] Using Outlook 4
David French Mass e-mail avoiding SPAM Using Outlook 1
Paul Van Cotthem Is calendar synchronization between Office 2013 and Outlook.com capped by spam or bandwidth limits? Using Outlook.com accounts in Outlook 12
T How to send to spam/delete emails with specific heading? Using Outlook 3
R Organising Spam Using Outlook 1
A VBA Script to Forward Spam to AntiSpam Provider Using "Blank" Form Outlook VBA and Custom Forms 2
C Outlook Changing Sent Message Headings to SPAM =?UTF-8?B?4Liq4Lij4LmJ4L Using Outlook 1
M No More Spam Mail Using Outlook 1
G why are my mails getting marked as spam? Outlook VBA and Custom Forms 1
X Open Hyperlinks in an Outlook Email Message (Help with Diane's solution) Outlook VBA and Custom Forms 3
G Calendar View in Outlook Office 365 - Doesn't show enough hours, and the 30/60 min choice isn't the solution Using Outlook 4
O VBA or other solution for Outlook tasks to OneNote Outlook VBA and Custom Forms 0
S Unique ID solution for all outlook items? Outlook VBA and Custom Forms 2
V Outlook Data File (PST) - Auto Backup Solution Using Outlook 3
S Need solution to Outlook mail handling/syncing/mobile situation, please Using Outlook 2
J Looking for a solution (maybe an add-in) to easily track email conversations Using Outlook 3
J A reporting and analysis solution for MS Exchange Exchange Server Administration 0
H Outlook 2007 - hide completed tasks from Outlook Today -Solution Using Outlook 2

Similar threads

Back
Top