After reading an email, you may be used to moving and archiving it to a specific folder as per some criteria, such as depending on their senders. In this article, we’ll introduce you a method, which can save you from manually locating folder and moving email.
To better manage a stalk of received emails, Outlook allows you to create some subfolders under Inbox and archive emails to these folders. However, with more and more subfolders, you may think it troublesome to find folder and move email manually.
So, you will long for methods to automate this process. Then, you may consider using Outlook Rules. Yet, rule will auto move a new email to a specific folder as soon as it lands into your mailbox. It means that the email will be moved out of Inbox directly before you read this mail.
In reality, what you want is to quickly archive an email to a specific folder after reading it. In this situation, rule is helpless. Thus, you need to utilize the other means. In the followings, we will introduce one to you.
Archive Read Emails to Different Folders Based on Senders
- At the very beginning, press “Alt + F11” in Outlook to access VBA editor.
- Then, copy and paste the following VBA code into an unused module.
Sub MoveEmailsBySender() Dim objInboxFolder As Outlook.Folder Dim objSelection As Outlook.Selection Dim 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 objTargetFolder As Outlook.Folder Dim strSenderName As String Set objInboxFolder = Outlook.Application.Session.GetDefaultFolder(olFolderInbox) 'Get selected emails Set objSelection = Outlook.Application.ActiveExplorer.Selection If objSelection.Count > 0 Then For Each objItem In objSelection If TypeOf objItem Is MailItem Then Set objMail = objItem strSenderEmailAddress = objMail.SenderEmailAddress 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 corresponding contact item For i = 1 To 3 strFilter = "[Email" & i & "Address] = " & strSenderEmailAddress Set objFoundContact = objContacts.Find(strFilter) If Not (objFoundContact Is Nothing) Then 'Get the target folder On Error Resume Next Set objTargetFolder = objInboxFolder.Folders(objFoundContact.FullName) If objTargetFolder Is Nothing Then Set objTargetFolder = objInboxFolder.Folders.Add(objFoundContact.FullName) End If Exit For End If Next i If objFoundContact Is Nothing Then strSenderName = Split(strSenderEmailAddress, "@")(0) strSenderName = UCase(Left(strSenderName, 1)) & Right(strSenderName, Len(strSenderName) - 1) On Error Resume Next Set objTargetFolder = objInboxFolder.Folders(strSenderName) If objTargetFolder Is Nothing Then Set objTargetFolder = objInboxFolder.Folders.Add(strSenderName) End If End If End If Next 'Move the emails to target folder objMail.Move objTargetFolder End If Next End If End Sub
- After that, follow the step introduced in “How to Run VBA Code in Your Outlook” to add this macro to ribbon.
- Eventually, you can have a try.
- First off, select one or more email in the Inbox folder.
- Then, click the new button in ribbon.
- At once, the selected email(s) will be moved to corresponding folders as per the sender.
Archive Old Items in Your Outlook
Though Outlook’s folders permit you to manage your items with ease, it is still suggested not to leave too many items in your PST file. That can make your PST file oversized and more prone to errors and damage. If the PST file is corrupt, you have to attempt difficult Outlook fix, which demands a powerful tool, such as DataNumen Outlook Repair.
Shirley Zhang is a data recovery expert in DataNumen, Inc., which is the world leader in data recovery technologies, including corrupt mdf and outlook repair software products. For more information visit www.datanumen.com