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
- For a start, launch your Outlook program.
- Then, in Outlook screen, you can press “Alt + F11” key buttons to access VBA editor.
- Next in the “Microsoft Visual Basic for Applications” window, you’re required to open an unused module or directly insert a new one.
- 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
- Then, you can run this macro at once. Just click the “Run” icon in the toolbar or tap on “F5” key button.
- After that, you will need to select a source Outlook file which is to be checked for expired emails.
- Later, after selecting and hitting “OK”, the macro will start running.
- 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.
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