Some users would like to classify and manage incoming emails by sender. This post will teach you how to let Outlook auto create the separate folders named as the senders’ names for storing the emails from specific senders.
In my previous article “How to Auto Classify and Archive Your Emails by Month with Outlook VBA”, I have introduced a means to auto classify and archive emails on basis of the specific month of the emails’ received time. Similar to this, many would like to auto file incoming emails by the senders’ contact full names. More specifically, it is to auto create respective folders named as the senders’ names and auto move the emails from the specific senders to the according folders. In response to this requirement, here we’ll expose the concrete VBA code to you. Now read on to get it in detail.
Auto Classify and Archive Incoming Emails by Sender’s Name
- At the very outset, launch your Outlook application.
- Then in the Outlook window, press “Alt + F11” keys.
- In the next “Microsoft Visual Basic for Applications” window, double click on the “ThisOutlookSession” project on the left side to open its own window.
- Subsequently, copy the following VBA codes into it.
Public objInboxFolder As Outlook.Folder Public WithEvents objIncomingItems As Outlook.Items Private Sub Application_Startup() Set objInboxFolder = Outlook.Application.Session.GetDefaultFolder(olFolderInbox) Set objIncomingItems = objInboxFolder.Items End Sub Private Sub objIncomingItems_ItemAdd(ByVal objItem As Object) Dim objMail As Outlook.MailItem Dim strSenderEmailAddress As String Dim objContacts As Outlook.Items Dim objContact As Object Dim i As Long Dim strFilter As String Dim objFoundContact As Outlook.ContactItem Dim objDestinationFolder As Outlook.Folder If objItem.Class = olMail Then Set objMail = objItem strSenderEmailAddress = objMail.SenderEmailAddress End If Set objContacts = Outlook.Application.Session.GetDefaultFolder(olFolderContacts).Items On Error Resume Next For Each objContact In objContacts If objContact.Class = olContact Then 'Find the sender's contact item For i = 1 To 3 strFilter = "[Email" & i & "Address] = " & strSenderEmailAddress Set objFoundContact = objContacts.Find(strFilter) If Not (objFoundContact Is Nothing) Then Set objDestinationFolder = objInboxFolder.Folders(objFoundContact.FullName) 'Create a folder named as the sender's contact full name If objDestinationFolder Is Nothing Then Set objDestinationFolder = objInboxFolder.Folders.Add(objFoundContact.FullName) End If Exit For End If Next i If objFoundContact Is Nothing Then Set objDestinationFolder = objInboxFolder.Folders("Unknown") 'Create a folder for emails from unknown senders If objDestinationFolder Is Nothing Then Set objDestinationFolder = objInboxFolder.Folders.Add("Unknown") End If End If End If Next 'Move the emails to target folder objMail.Move objDestinationFolder End Sub
- After that, sign this code.
- Later change your Outlook macro settings to allow the signed macros.
- Eventually you can restart Outlook application to activate the new macro.
- From now on, Outlook will auto classify and archive incoming emails by the senders’ contact full names, like the following screenshot:
Deal with Vexing Outlook PST Troubles
Though Outlook PST is error prone, you still can make some precautions to block and deal with errors effectively. For instance, you can keep a potent Outlook fix tool in vicinity, such as DataNumen Outlook Repair. It can help you to successfully get rid of various annoying PST issues and even be able to extract maximum data from the corrupt PST file without breaking a sweat.
Shirley Zhang is a data recovery expert in DataNumen, Inc., which is the world leader in data recovery technologies, including sql repair and outlook repair software products. For more information visit www.datanumen.com