1) Create a Macro using the VBA editor – Hit Alt+F11
2) Copy the following Code and Paste it into the ThisOutlookSession module. (You have to expand the items shown in VBA editor)
3) Save and test your code
Note: This code will work ONLY in the current session UNLESS you digitally sign it. (due to Outlook’s Macro security)
If you want to digitally sign the Macro, generate your own certificate and sign the macro.
Private Sub Application_ItemSend(ByVal Item As Object, _
Cancel As Boolean)
Dim objNS As NameSpace
Dim objFolder As MAPIFolder
Set objNS = Application.GetNamespace("MAPI")
Set objFolder = objNS.PickFolder
If TypeName(objFolder) "Nothing" And _
IsInDefaultStore(objFolder) Then
Set Item.SaveSentMessageFolder = objFolder
End If
Set objFolder = Nothing
Set objNS = Nothing
End Sub
Public Function IsInDefaultStore(objOL As Object) As Boolean
Dim objApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objInbox As Outlook.MAPIFolder
On Error Resume Next
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Select Case objOL.Class
Case olFolder
If objOL.StoreID = objInbox.StoreID Then
IsInDefaultStore = True
End If
Case olAppointment, olContact, olDistributionList, _
olJournal, olMail, olNote, olPost, olTask
If objOL.Parent.StoreID = objInbox.StoreID Then
IsInDefaultStore = True
End If
Case Else
MsgBox "This function isn't designed to work " & _
"with " & TypeName(objOL) & _
" items and will return False.", _
, "IsInDefaultStore"
End Select
Set objApp = Nothing
Set objNS = Nothing
Set objInbox = Nothing
End Function
While i was using outlook 2007 on XP this worked great. I recently switched to windows 7 64 bit and this macro on outlook 2007 doesn’t work correctly.
For this macro to work, i have to open up the VB Editor and click save and this macro works until I restart outlook. Do you know why I’m having this issue? I have my macro security settings to “No security check for macros.”
To get the macro to work without having to open VBA and hitting save each time, you need to digitally sign the Macro. To generate your own certificate and sign the macro do this:
Go to:
C:\Program Files (x86)\Microsoft Office\Office12
Run the Program ‘SelfCert.exe’
Type in whatever you want to name the certificate, your name works.
Choose OK and your new certificate will be saved.
Go back to outlook and Press Alt+F11 to open the ‘Visual Basic Editor for Outlook’
Open ThisOutlookSession where you typed your code.
On the toolbar, click Tools and select Digital Signature.
Click the Choose button.
Click the certificate you created and click the OK button.
Click the save button.
Exit out of VBA and outlook.
Restart outlook. It should work then.
Everything seems to work except that the email doesn’t get saved to the folder chosen!?! It still goes to Sent Items. Any idea why?