Outlook: Archive Items by Month Into separate Files

[kjv1611]

Outlook has the manual and auto archive options. Auto archive lets you pick one specific file location to archive to. Manually, you can archive whatever you want to whatever folder you want.

Right now, we have a mailbox which I have to check on occasion, and I need to manually archive the past quarter's worth of emails.

What I would like to do is write a VBA script (or something else if more appropriate) to automatically archive "last month's messages" to a file based on the year and month. I'd just say call it YYYYMM for simplicity sake. For example, if I did it today for August, the file would be 201708.pst.

Has anyone done anything like this in Outlook before, and can you offer any starting points or suggestions along the way? I'd want it to run automatically. I'd say only run it the first day of each month, but I think it'd make the most sense to simply run at startup of Outlook or startup plus a few minutes to reduce any load on Outlook.

Thanks for any thoughts.

"But thanks be to God, which giveth us the victory through our Lord Jesus Christ." 1 Corinthians 15:57

 

[TonyJollans]

Outlook is not my best strength but as no-one has replied to this, I'll try.

I don't have current access to an Exchange server and some of the required code might be slightly different but this works on a stand-alone Outlook system ..

[blue]Sub Archive()
    
    Dim oNameSpace              As Outlook.NameSpace
    
    Dim InboxFolder             As Outlook.MAPIFolder
    Dim PST                     As Outlook.MAPIFolder
    Dim ArchiveFolder           As Outlook.MAPIFolder
    
    Dim DefaultFilePath         As String
    Dim PSTFileName             As String
    Dim ndx                     As Long

    Set oNameSpace = Application.GetNamespace("MAPI")

    [green]' Find the location of the default Inbox, as an arbitrary location for the new PST[/green]
    [green]' (e.g. "C:\Users\Tony\Documents\Outlook Files")[/green]
    With oNameSpace.DefaultStore
        DefaultFilePath = Left(.FilePath, InStrRev(.FilePath, "\"))
    End With
    
    PSTFileName = Format(DateAdd("m", -1, Date), "yyyymm")
    
    [green]' Create the new PST in the above location with the above name as file name[/green]
    [green]' Note that if the PST already exists, it will be opened and a new one not created[/green]
    oNameSpace.AddStoreEx DefaultFilePath & PSTFileName & ".pst", olStoreDefault
    
    [green]' Access the new PST and name it[/green]
    Set PST = oNameSpace.Folders.GetLast
    PST.Name = PSTFileName
    
    [green]' Create a folder for the archived mail[/green]
    [green]' Note that  this will fail if the folder already exists in an already-existing PST[/green]
    [green]' An error trap or a check for existence may be needed[/green]
    Set ArchiveFolder = PST.Folders.Add(PSTFileName)
    
    [green]' Get a reference to the source Inbox[/green]
    [green]' This is the default Inbox, and will need changing to get a different Inbox[/green]
    With oNameSpace.DefaultStore
        Set InboxFolder = .GetDefaultFolder(olFolderInbox)
    End With
    
    [green]' Move mail items with a date in the month of the file name[/green]
    With InboxFolder
        [green]' When deleting (which MOVing implies), work backward to properly maintain position[/green]
        For ndx = .Items.Count To 1 Step -1
            With .Items(ndx)
                If Format(.ReceivedTime, "yyyymm") = PSTFileName Then .Move ArchiveFolder
            End With
        Next ndx
    End With
    
    [green]' Finally close the new PST[/green]
    oNameSpace.RemoveStore PST
    
End Sub[/blue]

The next issue is running it. I wouldn't personally be too concerned about system load and running it at start-up and somehow checking for new month would probably work well enough. Outlook doesn't have any very good macro scheduling capacity and if you wanted to automate more cleverly, I would probably suggest creating a monthly appointment and setting a reminder that could be trapped by an event - it's a bit fiddly and, to an extent, non-intuitive, but should work although, as I say, I'm not sure it's worth the effort.


Enjoy,
Tony

------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.

I'm working (slowly) on my own website

 

[kjv1611]

Thanks! I'll give it a look when I can come back to this. Our system is setup as stand-alone units anyway, as we do not have Exchange.

"But thanks be to God, which giveth us the victory through our Lord Jesus Christ." 1 Corinthians 15:57