Macro Magic - Changing the location of the save sent message folder
When you are sending a message, you have the ability via the Options dialog (from the View menu) to change the folder location of where Outlook stores a copy of the message you are sending. This defaults to the Sent Messages folder for the default store. However, if you pick a folder from somewhere other than the default store (i.e. another loaded .PST, etc.), you get the following error:
All is not lost though! You CAN change this with a macro. The code below could be of use to anyone who loads multiple stores associated with different e-mail accounts, and likes to store messages sent using those accounts in a folder for that store. If you have more than one location where you would like to store these messages, create one macro for each folder.
Simply modify the code below to change the IDs for the Folder and the Store where it resides. If you're quite familiar with Outlook VBA, its fairly straightforward to find the IDs for a particular folder by walking through the Folders collections in the related InfoStore object. An easier alternative is to use OutlookSpy to pry the value from a nice GUI.
When you're ready, create a custom button on your toolbar somewhere (with the new mail message window open) and map it to the macro that you just created. Before you send the message, click the button to change the folder, and presto! A copy of the sent message will now be stored in the folder you specified.
Public Sub SaveReplyToAnotherFolder()
On Error Resume Next
Dim objMessage As Outlook.MailItem
Dim objFolder As Outlook.MAPIFolder, objNS As Outlook.NameSpace
Dim SentItemsFolderID As String
Dim SentItemsFolderStoreID As String
SentItemsFolderID = "000000001B047F6E4D67CA40BC5F0C90C878DD8002810000"
SentItemsFolderStoreID = "0000000038A1BB1005E5101AA1BB08002B2A56C200006D737073742E646C6C“ _
& “00000000004E495441F9BFB80100AA0037D96E0000000043003A005C0044006F“ _
& “00630075006D0065006E0074007300200061006E00640020005300650074007400690“ _
& “06E00670073005C0065007200690063006C005C004C006F00630061006C00200053006“ _
& “5007400740069006E00670073005C004100700070006C00690063006100740069006F006E“ _
& “00200044006100740061005C004D006900630072006F0073006F00660074005C004F0075007“ _
& “4006C006F006F006B005C0053006800610077002E007000730074000000"
If Application.ActiveInspector.CurrentItem.Class <> Outlook.OlObjectClass.olMail Then Exit Sub
Set objNS = Application.GetNamespace("MAPI")
Set objFolder = objNS.GetFolderFromID(SentItemsFolderID, SentItemsFolderStoreID)
If objFolder Is Nothing Then
MsgBox "Unable to set Sent Message folder."
Exit Sub
End If
Set objMessage = Application.ActiveInspector.CurrentItem
Set objMessage.SaveSentMessageFolder = objFolder
End Sub