none
How to move old messages to an archive folder that has the same name as the original folder RRS feed

  • Question

  • I'd like to automate my Outlook folders by moving mail older than X date to my archive folders. I found code online that will allow me to select the folder I want to move my mail items in, however I want Outlook to look for the folder in my Archive account with the same name as the current folder. For example, if I want to copy mail from the "me@email.com\Cabinet\Project A" folder I want the macro to use the folder name "Project A" to look for the "Online Archive - me@email.com\Cabinet\Project A" folder. Is there any way to modify the code below? Thank you! 

    ' Source: https://support.microsoft.com/en-us/kb/249597
    Sub MoveMailItems()
       Dim olns As Outlook.NameSpace
       Dim oConItems As Outlook.Items
       Dim iNumItems As Integer
       Dim iNumFinalItems As Integer
       Dim numdiff As Integer
       Dim dDate As Date
       Dim objTargetFolder As Outlook.MAPIFolder
       
       Const Days = 90

       Set objNS = Application.GetNamespace("MAPI")
       Set oMailItems = Application.ActiveExplorer.CurrentFolder.Items
       
       Set objTargetFolder = Outlook.Session.PickFolder '
       
       iNumItems = oMailItems.Count
       
       MsgBox iNumItems
       
       For I = iNumItems To 1 Step -1
          Set objCurItem = oMailItems.Item(I)
          If TypeName(objCurItem) = "MailItem" Then
             ' Move only mail messages
             dDate = objCurItem.SentOn
             If DateDiff("d", dDate, Now) > Days Then
                objCurItem.Move objTargetFolder
                objCurItem.Delete
             End If
          End If
       Next
       
       iNumFinalItems = oMailItems.Count
       numdiff = iNumItems - iNumFinalItems
       

       MsgBox "Finished moving " & numdiff & " items."

       Set objMailItems = Nothing
       Set objTargetFolder = Nothing
       Set objNS = Nothing

    End Sub

    Wednesday, December 21, 2016 2:36 PM