Automatically file Outlook Sent Items to a folder

A commenter on one of my other macros requested this functionality.

Whenever you send an e-mail in Outlook have it prompt you if you want it filed in a folder other than the default Sent Items folder.
Here it is.

Two caveats:
I’m assuming that you are using the default Sent Items folder.
You will have to edit the code to point it to the folder you wish to use.

First you have to define the event handler to monitor your sent items folder.

Private WithEvents SentItems As Outlook.Items

Private Sub Application_Startup()

 Dim NS As Outlook.NameSpace
 Set NS = Application.GetNamespace("MAPI")
 Set SentItems = NS.GetDefaultFolder(olFolderSentMail).Items

End Sub

Now you have to add a routine to handle it.

Private Sub SentItems_ItemAdd(ByVal item As Object)
 
 Dim objMailItem As mailItem
 Set objMailItem = item
 Dim arcFolder As Outlook.MAPIFolder
 Set arcFolder = Outlook.Application.Session.Folders.item("Personal Folders (C)").Folders.item("___ToDo")
 If MsgBox("Move To ToDo?", vbYesNo) = vbYes Then
 objMailItem.Move arcFolder
 End If
 
End Sub

I have a “ToDo” folder in my Personal Folders mailbox (the leading underscores are simply to “help” the sorting in the default view.

It’s this arcFolder location that you will have to adjust to your own required location.