VBA multiple accounts

[Outl00k]

I used to have 1 email account and used the code below to file sent emails. I now have 2 email accounts (actually 3 if you count my gmail). This code only works for the original account. How can I get this to work with the other outlook account (and gmail if possible)?



Dim 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

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

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

Set objFolder = Nothing
Set objNS = Nothing

End If

End Sub