Filing Sent Items

[Outl00k]

I have 2 email accounts (actually 3 if you count my gmail). This only works for 1 of my outlook accounts. How can I get this to work with the other outlook account (and gmail if possible).

If you want to leave a copy in the Sent Items folder, then you need to create a copy of the message and move that to the selected folder:

Option Explicit

Private WithEvents colSentItems As Items
 
Private Sub Application_Startup()
    Dim ns As Outlook.NameSpace
    Set ns = Application.GetNamespace("MAPI")
     '   Set event handler on the sent items folder to monitor when new items are saved to the folder
    Set colSentItems = ns.GetDefaultFolder(olFolderSentMail).Items
    Set ns = Nothing
End Sub

Private Sub colSentItems_ItemAdd(ByVal Item As Object)

Dim objNS As NameSpace
Dim objFolder As MAPIFolder
Dim oCopiedItem As MailItem

    '   This is fired every time an item is added to the Sent Items Folder
    If Item.Class = olMail Then
        Set oCopiedItem = Item.Copy

        '   Only do this if the item is a sent email, ignore meeting requests etc.
        Set objNS = Application.GetNamespace("MAPI")
        Do While objFolder Is Nothing
            Set objFolder = objNS.PickFolder
        Loop
        If TypeName(objFolder) = "MAPIFolder" Then
            If Not objFolder = objNS.GetDefaultFolder(olFolderSentMail) Then
                '               move email to the selected folder
                oCopiedItem.Move objFolder
            End If
        End If
        Set objFolder = Nothing
        Set objNS = Nothing
    End If
End Sub