The following VBA code will automatically move any sent emails to another mailbox, the department mailbox, if the sent on behalf or sent from email address is set to that department email address.
So if at work I create an email and select sent from "DepartmentEmailAddressName" this macro will automatically move the sent item from my sent folder to the sent folder of Mail box "Mailbox - Department Name"
In Outlook hit ALT + F11 and place the code in the ThisOutlookSession module in VBAProject.OTM.
Private WithEvents MySents As Outlook.Items
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
If MySents Is Nothing Then
Application_Startup
End If
End Sub
Private Sub Application_Startup()
'writen by Edgar Badawy 16/12/2010
Dim objNS As Outlook.NameSpace
Dim objSentFolder As Outlook.MAPIFolder
Set objNS = Application.Session
Set MySents = objNS.GetDefaultFolder(olFolderSentMail).Items
End Sub
Private Sub MySents_ItemAdd(ByVal Item As Object)
'writen by Edgar Badawy 16/12/2010
Dim objNS2 As Outlook.NameSpace
Dim moveFolder As Folder
Set objNS2 = Outlook.GetNamespace("MAPI")
Set moveFolder = objNS2.Folders("Mailbox - Department Name").Folders("Sent Items")
If TypeOf Item Is Outlook.MailItem Then
If Item.SenderName = "DepartmentEmailAddressName" Then
Item.Move moveFolder
End If
End If
Set objNS2 = Nothing
Set moveFolder = Nothing
End Sub
