How to Quickly Archive Read Emails to Different Folders Based on Their Senders in Outlook

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

  1. At the very beginning, press “Alt + F11” in Outlook to access VBA editor.
  2. 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
               'Move the emails to target folder
               objMail.Move objTargetFolder
            End If
    End If
End Sub

VBA Code - Archive Read Emails to Different Folders Based on Senders

  1. After that, follow the step introduced in “How to Run VBA Code in Your Outlook” to add this macro to ribbon.
  2. Eventually, you can have a try.
  • First off, select one or more email in the Inbox folder.
  • Then, click the new button in ribbon.Run Macro on Selected Emails
  • At once, the selected email(s) will be moved to corresponding folders as per the sender.Emails Moved to Specific Folders

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.

Author Introduction:

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

Comments are closed.