If you want to let Outlook automatically archive the received emails which are not flagged after a certain age to a specific folder, you can use the method introduced in this article.
Unlike auto moving the incoming emails to a specific folder as soon as they arrive in the mailbox, you may desire to auto archive the received emails which are not flagged for follow up when they are in a certain age, namely they are not flagged and older than a specific period. However, Outlook rule cannot help you achieve it. You have to seek other means, like third party add-ins or Outlook VBA. Thus, in the followings, we’ll teach you how to use VBA to get it.
Auto Archive the Incoming Emails without Follow up Flags
- At the very outset, start your Outlook program.
- Then switch to “Developer” tab and click on “Visual Basic” button. Or press “Alt + F11” key shortcuts.
- Subsequently, in the VBA editor window, you need to find and double click on the “ThisOutlookSession” on the left side.
- Next copy the following codes into the “ThisOutlookSession” project window.
Private Sub Application_Startup() 'Auto run the "GetInboxFolders" subroutine when Outlook starts Call GetInboxFolders End Sub Private Sub GetInboxFolders() Dim objInboxFolder As Outlook.Folder Dim strMsg As String strMsg = "" Set objInboxFolder = Outlook.Application.Session.GetDefaultFolder(olFolderInbox) Call ArchiveEmailsBasedonFollowupFlags(objInboxFolder, strMsg) If strMsg = "" Then MsgBox ("All emails older than 30 days in " & objInboxFolder.Name & " are archived.") Else MsgBox ("The following emails older than 30 days in " & objInboxFolder.Name & " are not archived because it has a flag:" & vbCrLf & vbCrLf & "Subject Line: " & vbCrLf & strMsg & vbCrLf & "All other emails are archived.") End If End Sub Private Sub ArchiveEmailsBasedonFollowupFlags(objFolder As Outlook.Folder, ByRef strCurMsg As String) Dim objDestinationFolder As Outlook.Folder Dim objItems As Outlook.Items Dim objMail As Outlook.MailItem Dim dReceivedTime As Date Dim nDateDiff As Integer Dim objSubFolder As Outlook.Folder 'You can change the destination folder as per your needs Set objDestinationFolder = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).parent.Folders("Aged") For i = objFolder.Items.Count To 1 Step -1 If TypeOf objFolder.Items.Item(i) Is MailItem Then Set objMail = objFolder.Items.Item(i) dReceivedTime = objMail.ReceivedTime nDateDiff = DateDiff("d", dReceivedTime, Now) If objMail.IsMarkedAsTask = False Then 'If the received emails are received 30 days ago 'move to the destination folder If nDateDiff > 30 Then objMail.Move objDestinationFolder End If ElseIf objMail.IsMarkedAsTask = True Then strCurMsg = objMail.Subject & vbCrLf & strCurMsg End If End If Next i 'Process all the subfolders under Inbox recursively If (objFolder.Folders.Count > 0) Then For Each objSubFolder In objFolder.Folders Call ArchiveEmailsBasedonFollowupFlags(objSubFolder, strCurMsg) Next End If End Sub
- After that, you should digitally sign the new VBA project.
- Next change your Outlook macro settings to permit the signed macros only.
- Finally you can restart Outlook now. When Outlook starts, the macro will be triggered at once.
- All the received emails, which are not flagged and are older than the specific period, will be automatically moved to the specific folder.
- If there are flagged emails which are older than the specific period, you will get a report, like the following image:
- If there are no flagged emails, all the emails will be archived. You will get the message, like the screenshot below:
Tackle Repulsive PST Errors
As you know, PST file is susceptible to errors and corruption. Therefore, you have to keep prepared all the time, like persisting to make regular PST data backups and getting hold of a robust Outlook recovery tool, such as DataNumen Outlook Repair. Otherwise, you will suffer PST corruption without any omens and have no immediate rescue means.
Shirley Zhang is a data recovery expert in DataNumen, Inc., which is the world leader in data recovery technologies, including corrupted SQL Server and outlook repair software products. For more information visit www.datanumen.com