Choose folder for sent items

With this VBA code you can choose for each e-mail the filing folder for the sent e-mail.

To use this example please read the important notes and have a look to the workshop Use VBA in Outlook®.

For Outlook® 2000, Outlook® 2002, Outlook® 2003, Outlook® 2007, Outlook® 2010

Please insert this first code part into a new module (Insert -> Module in the VBA-Editor):

Option Explicit
 
Public Function SentFolder(ByRef Item As Object) As Boolean
 
    '=====================================================================
    ' Shows a folder picker if sending an e-mail to save the e-mail in a
    ' different folder instead of "Sent Items".
    ' (c) Peter Marchert - http://www.outlook-stuff.com
    ' 2008-11-19 Version 1.0.1
    '=====================================================================
 
    Dim objFolder As Object
 
    '---------------------------------------------------------------------
    ' Should also work with meeting items but does not. Works only with
    ' mail items.
    '---------------------------------------------------------------------
    If Not Item.Class = olMail Then Exit Function
 
    '---------------------------------------------------------------------
    ' Execute the loop until a guilty folder is choosen or the user cancled
    ' the dialog.
    '---------------------------------------------------------------------
    Do
 
        '-----------------------------------------------------------------
        ' Show folder picker
        '-----------------------------------------------------------------
        Set objFolder = Nothing
        Set objFolder = Outlook.Session.PickFolder
 
        '-----------------------------------------------------------------
        ' User cancled?
        '-----------------------------------------------------------------
        If objFolder Is Nothing Then 
            SentFolder = True
            Exit Function
        End If
 
        '-----------------------------------------------------------------
        ' Wrong folder type?
        '-----------------------------------------------------------------
        If InStr(objFolder.DefaultMessageClass, "IPM.Note") = 0 Then
            Set objFolder = Nothing
            If MsgBox("Pleaser choose a folder for e-mails." _
                , vbCritical + vbOKCancel, "Choose folder") = vbCancel Then
                SentFolder = True
                Exit Function
            End If
        End If
 
        '-----------------------------------------------------------------
        ' The inbox is not a good idea to save sent items
        '-----------------------------------------------------------------
        If Not objFolder Is Nothing Then
            If objFolder = Outlook.Session.GetDefaultFolder(olFolderInbox) Then
                If MsgBox("Do you really want to save the e-mail in the Inbox?" _
                    , vbExclamation + vbYesNo + vbDefaultButton2, "Choose folder") = vbNo Then
                    Set objFolder = Nothing
                End If
            End If
        End If
 
    Loop While objFolder Is Nothing
 
    '---------------------------------------------------------------------
    ' Set the filing folder of the e-mail
    '---------------------------------------------------------------------
    Set Item.SaveSentMessageFolder = objFolder
 
    '---------------------------------------------------------------------
    ' Clear reference to the folder
    '---------------------------------------------------------------------
    Set objFolder = Nothing
 
End Function

The call comes from the Application_ItemSend event in the module ThisOutlookSession, where you put the second code part in:

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
 
    '=====================================================================
    ' This procedure will be called directly before an e-mail will be send.
    ' If "Cancel" is True then the send event will be cancled.
    ' (c) Peter Marchert - http://www.outlook-stuff.com
    ' 2008-11-19 Version 1.0.1
    '=====================================================================
 
    '---------------------------------------------------------------------
    ' Shows a folder picker if sending an e-mail to save the e-mail in a
    ' different folder instead of "Sent Items".
    '---------------------------------------------------------------------
    Cancel = SentFolder(Item)
 
    '---------------------------------------------------------------------
    ' Delete reference to the e-mail
    '---------------------------------------------------------------------
    Set Item = Nothing
 
End Sub

See also article Combine functions