Auto Block Unwanted Emails with the Blacklist in a Text File
As I get a lot of spams every Day I'm looking for a method to handle this easily.
I have may POP accounts in a single PST file.
As I learned that Outlook has blacklists for every account the "Block Sender" function in Outlook does not work!
In addition, I have 3 Outlooks synct via SimpleSyn so if I block one sender in 1st Ol 2nd Ol will not know This and receive the mail which is the synct to the 2 Other OLs. – CLEAR?
So I'm looking For a method to block senders in this Scenario.
What I found is This Macro
Code:
Public WithEvents objInboxFolder As Outlook.FolderPublic 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 = "E:\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
From Here:
How to Auto Block Unwanted Outlook Emails with the Blacklist in a Text File - Data Recovery Blog (datanumen.com)
I must say I'm not clever enough to understand how it works BUT it Does.
In BlackList.txt I have:
name@domain.com
As I receive a lot of spam from the same domain It is necessary to have the Domain itself blocked.
If I change the content of the Blacklist.txt file to
*@domain.com Or
@domain.com
The macro does not work anymore.
So my question is
How can the macro be modified so that it would also work if in the list is either
name@domain.com
or/ and
*@domain.com Or @domain.com
Hope for help.
