Private Sub Application_Startup() Dim objOutlook As Outlook.Application Dim objNamespace As Outlook.NameSpace Dim objSourceFolder As Outlook.MAPIFolder Dim objDestFolder As Outlook.MAPIFolder Dim objVariant As Variant Dim lngMovedItems As Long Dim intCount As Integer Dim intDateDiff As Integer Dim strDestFolder As String '''''''''' '''''''''' '''''''''' '''''''''' '''''''''' Inbox Folder '''''''''' '''''''''' '''''''''' '''''''''' '''''''''' Set objOutlook = Application Set objNamespace = objOutlook.GetNamespace("MAPI") Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox) ' use a subfolder under Inbox Set objParent = Session.GetDefaultFolder(olFolderInbox) Set objManaged = objParent.Parent.Folders("Managed Folders") Set objDestFolder = objManaged.Folders("7 Year Retention") For intCount = objSourceFolder.Items.Count To 1 Step -1 Set objVariant = objSourceFolder.Items.Item(intCount) DoEvents If objVariant.Class = olMail Then intDateDiff = DateDiff("d", objVariant.SentOn, Now) ' I'm using 60 days, adjust as needed. If intDateDiff > 60 Then objVariant.Move objDestFolder 'count the # of items moved lngMovedItems = lngMovedItems + 1 End If End If Next ' Display the number of items that were moved. MsgBox "Moved " & lngMovedItems & " messages(s) From your Inbox ." Set objDestFolder = Nothing '''''''''' '''''''''' '''''''''' '''''''''' '''''''''' Sent Mail Folder '''''''''' '''''''''' '''''''''' '''''''''' '''''''''' Set objOutlook = Application Set objNamespace = objOutlook.GetNamespace("MAPI") Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderSentMail) ' use a subfolder under Inbox Set objParent = Session.GetDefaultFolder(olFolderInbox) Set objManaged = objParent.Parent.Folders("Managed Folders") Set objDestFolder = objManaged.Folders("7 Year Retention") For intCount = objSourceFolder.Items.Count To 1 Step -1 Set objVariant = objSourceFolder.Items.Item(intCount) DoEvents If objVariant.Class = olMail Then intDateDiff = DateDiff("d", objVariant.SentOn, Now) ' I'm using 7 days, adjust as needed. If intDateDiff > 60 Then objVariant.Move objDestFolder 'count the # of items moved lngMovedItems = lngMovedItems + 1 End If End If Next ' Display the number of items that were moved. MsgBox "Moved " & lngMovedItems & " messages(s) From your Sent Mail." Set objDestFolder = Nothing End Sub