How to Auto Block Outlook Emails from Those Not In a Whitelist

If you’ve stored hundreds of safe senders in a text file, namely a whitelist, you may wish Outlook to auto block the emails from the senders who aren’t included in this whitelist. Now, in this article, we will introduce you a smart way to get it.

In the previous article – “How to Auto Block Unwanted Outlook Emails with the Blacklist in a Text File“, you can learn a method to block the emails from those in a blacklist. Similar to that, you may also want to auto block the emails from those who are not in a whitelist. Thereinafter, we will teach you a method.

Auto Block Emails from Those Not In a Whitelist

  1. For a start, launch Outlook application.
  2. Then, trigger Outlook VBA editor according to “How to Run VBA Code in Your Outlook.
  3. In the subsequent window, put the following code into “ThisOutlookSession” project.
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
   Dim strWhitelist As String

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

      'Modify the path to the specific text file
      strTextFile = "E:\Whitelist.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
                    strWhitelist = objMatch.Value & ";" & strWhitelist
                Next
             End If
          End If
       Loop

       If InStr(strWhitelist, strSenderEmailAddress) = 0 Then
          objMail.Move objJunkFolder
      End If
   End If
End Sub

VBA Code - Auto Block Outlook Emails from Those Not In a Whitelist

  1. After that, restart Outlook to activate this macro.
  2. Since then, every time a new email arrives, Outlook will auto check if the sender is in the whitelist. If not, the email will be moved to “Junk E-mail” folder automatically.Auto Blocked Emails

Keep Cautious of Unknown Emails

Every time when you receive an email from unknown senders or sources, you’d better raise you vigilance. It is because that the emails may contain the malicious matters that can lead to Outlook corruption. Once Outlook PST file gets damaged, you need to make use of a robust PST repair utility, such as DataNumen Outlook Repair.

Author Introduction:

Shirley Zhang is a data recovery expert in DataNumen, Inc., which is the world leader in data recovery technologies, including repair mdf and outlook repair software products. For more information visit www.datanumen.com