How to Quickly Archive All Expired Emails in Your Outlook

Outlook permits users to set expiry time for emails. Such emails are shown in grey strikethrough font. If you wish to quickly archive all the expired emails, you can use the method introduced in this article.

You can set any expiry time for any emails in Outlook. Once expire time is passed, the emails will be marked as expired with a grey strikethrough. In this scenario, it is always suggested to quickly archive them as they are probably not useful any longer. Archiving them can reduce the size of your Outlook file in some degree. In the followings, we will teach you how to rapidly archive all expired emails in your Outlook.

Quickly Archive All Expired Emails

1. For a start, launch your Outlook program.
2. Then, in Outlook screen, you can press “Alt + F11” key buttons to access VBA editor.
3. Next in the “Microsoft Visual Basic for Applications” window, you’re required to open an unused module or directly insert a new one.
4. Subsequently, you ought to copy the following VBA code into this module.

Dim objArchiveFile As folder
Dim objArchiveFolder As folder

Sub ArchiveAllExpiredEmails()
    Dim objOutlookFile As Outlook.folder
    Dim objFolder As Outlook.folder
 
    Set objOutlookFile = Application.Session.PickFolder
    
    'Open the Archive PST File
    Application.Session.AddStore "C:\Users\Test\Documents\Outlook Files\Archive.pst"
    Set objArchiveFile = Application.Session.folders("Archives")
 
    If Not (objOutlookFile Is Nothing) Then
 
       For Each objFolder In objOutlookFile.folders
           If objFolder.DefaultItemType = olMailItem Then
              Call ProcessFolders(objFolder)
           End If
       Next
 
       'If want to close the Archive PST file, use the following line
       'Application.Session.RemoveStore objArchivePSTFile
 
        MsgBox "Complete!", vbExclamation
    End If
End Sub

Sub ProcessFolders(ByVal objCurrentFolder As Outlook.folder)
    Dim i As Long
    Dim objMail As Outlook.MailItem
    Dim objSubfolder As Outlook.folder
 
    For i = objCurrentFolder.Items.count To 1 Step -1
        If TypeOf objCurrentFolder.Items(i) Is MailItem Then
           Set objMail = objCurrentFolder.Items(i)
 
           'Move Expired Emails to Archive File
           If objMail.ExpiryTime < Now Then
 
              On Error Resume Next
              Set objArchiveFolder = objArchiveFile.folders(objCurrentFolder.Name)
              If objArchiveFolder Is Nothing Then
                 Set objArchiveFolder = objArchiveFile.folders.Add(objCurrentFolder.Name)
              End If
 
              objMail.Move objArchiveFolder
           End If
       End If
    Next
 
    'Process All Subfolders Recursively
    If objCurrentFolder.folders.count > 0 Then
       For Each objSubfolder In objCurrentFolder.folders
           Call ProcessFolders(objSubfolder)
       Next
    End If
End Sub

5. Then, you can run this macro at once. Just click the “Run” icon in the toolbar or tap on “F5” key button.
6. After that, you will need to select a source Outlook file which is to be checked for expired emails.
7. Later, after selecting and hitting “OK”, the macro will start running.
8. When you receive the message prompting “Completes”, the expired emails have been moved to the Archive PST file in success.

In Case of Outlook Crashes

If you are a regular user of Outlook for decades, your Outlook data file may have been in a pretty large size. In this case, the file is actually very vulnerable to many factors. As we all know, though Outlook is touted as an extraordinary email client, it is still prone to crash and get damaged. Thus, you’d better prepare an advanced Outlook repair tool nearby, such as DataNumen Outlook Repair. It can rescue you from Outlook data corruption like a breeze.

Author Introduction:

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