How to Auto Archive Old Emails Larger Than a Specific Size in Outlook

If you want to make your Outlook to automatically archive the old emails which are larger than a specific size, you can utilize the following means shared in this article.

From my previous article “How to Archive Outlook Emails Larger Than a Specific Size”, you can learn a standard way to archive large emails. However, it’s pretty tedious as it demands you to archive manually. In addition, it only permits you to archive the emails in one folder at a time. So, if you would like to let Outlook auto archive the large old emails in all mail folders, you have to seek other ways, such as the following one.

Auto Archive Old Emails Larger Than a Specific Size in Outlook

Auto Archive Old Emails Larger Than a Specific Size

  1. At the very outset, launch your Outlook application.
  2. Then access to the “Tasks” pane.
  3. Next you ought to create a recurring task with an enabled reminder.
  • Firstly, click “New Task” button in ribbon.
  • In the new Task window, enter a subject, such as “Auto Archive Large Old Emails”.
  • Then click “Recurrence” button and set a task recurrence on basis of how often you want to auto archive.
  • After that, enable a reminder as per the time you wish to auto archive.
  • Lastly, click “Save & Close” button.Create a recurring task with an enabled reminder
  1. Subsequently, after backing to the main Outlook window, you can press “Alt + F11” keys.
  2. And then you will enter the “Microsoft Visual Basic for Applications” window, in which you need to open the “ThisOutlookSession” project.
  3. After that, copy the following VBA code into this project window.
Dim objArchivePSTFile As Outlook.Folder

Private Sub Application_Reminder(ByVal Item As Object)
    If TypeOf Item Is TaskItem And Item.Subject = "Auto Archive Large Old Emails" Then
       Call AutoArchiveOldEmails_LargerThanASpecificSize
 
       'Dismiss the reminder
       Item.MarkComplete
    End If
End Sub

Private Sub AutoArchiveOldEmails_LargerThanASpecificSize()
    Dim objPSTFile As Outlook.Folder
    Dim objFolder As Outlook.Folder
 
    'Open the specific Archive Outlook PST file in your Outlook
    Application.Session.AddStore "C:\Users\Test\Documents\Outlook Files\Archive.pst"
    Set objArchivePSTFile = Application.Session.folders("Archives")
 
    'Specify the source Outlook PST file
    Set objPSTFile = Outlook.Application.Session.folders("John Smith")
 
    For Each objFolder In objPSTFile.folders
        Call ProcessFolders(objFolder)
    Next
 
    'Remove the Archive PST file from your Outlook
    Application.Session.RemoveStore objArchivePSTFile
 
End Sub

Private Sub ProcessFolders(ByVal objCurrentFolder As Outlook.Folder)
    Dim i As Long
    Dim objMail As Outlook.MailItem
    Dim nDateDiff As Integer
    Dim lMailSize As Long
    Dim objArchiveFolder As Outlook.Folder
    Dim objSubfolder As Outlook.Folder
 
    'Work on emails only
    If objCurrentFolder.DefaultItemType = olMailItem Then

       For i = objCurrentFolder.Items.count To 1 Step -1

           If objCurrentFolder.Items(i).Class = olMail Then
              Set objMail = objCurrentFolder.Items(i)
 
              nDateDiff = DateDiff("d", objMail.SentOn, Now)
 
              'Older than 30 days
              If nDateDiff > 30 Then
 
                 lMailSize = objMail.Size
                 lMailSize = (lMailSize / 1024) / 1024
 
                 'Larger than 2 MB
                 If lMailSize >= 2 Then
 
                    On Error Resume Next
                    Set objArchiveFolder = objArchivePSTFile.folders(objCurrentFolder.Name)
 
                    If objArchiveFolder Is Nothing Then
                       Set objArchiveFolder = objArchivePSTFile.folders.Add(objCurrentFolder.Name)
                    End If
 
                    'Archive it
                    objMail.Move objArchiveFolder
                 End If
              End If
          End If
      Next i
    End If
 
    'Process subfolders recursively
    If objCurrentFolder.folders.count > 0 Then
       For Each objSubfolder In objCurrentFolder.folders
           Call ProcessFolders(objSubfolder)
       Next
    End If

End Sub

VBA Code - Auto Archive Old Emails Larger Than a Specific Size

  1. Later you should sign this code and change Outlook macro settings to enable signed macros.
  2. From now on, every time when the task reminder pops up, Outlook will auto archive the emails that are older than the predefined days and larger than a specific size.

Make Backups for Your Outlook Regularly

Due to the fact that Outlook is vulnerable, in order to protect your Outlook data, you have to make consistent and regular data backups. Otherwise, as long as your Outlook gets corrupt, you will have no alternative but to fall back on a powerful external utility, such as DataNumen Outlook Repair. It has shouldered over many of its rivals since it can fix Outlook files in a jiffy and without any fuss.

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 www.datanumen.com

Leave a Reply

Your email address will not be published. Required fields are marked *