There are two ways you can use a VBA macro to save all messages to a hard drive: use an ItemAdd macro to watch for new messages in your Inbox or use a Run a Script rule.
If you want to save every message, it's generally better to use the ItemAdd macro since it can handle a larger volume of messages. The Run a Script rule is great for low volume accounts or when you only need to save some messages.
If you need to save messages already downloaded, see Save selected email message as .msg file. It's essentially the same macro, but works with selected messages.
Using ItemAdd
This ItemAdd macro is a simpler version of the macro at E-Mail: Save new items immediately as files. My version saves all messages in the user's profile path, in the native Outlook .msg format.
If you need to watch a folder other than your Inbox, see Working with VBA and non-default Outlook Folders.
To use this code, paste it in the ThisOutlookSession module. To test this code sample without restarting Outlook, click in the Application_Startup procedure then click Run.
Option Explicit Private WithEvents Items As Outlook.Items Private Sub Application_Startup() Dim Ns As Outlook.NameSpace Set Ns = Application.GetNamespace("MAPI") Set Items = Ns.GetDefaultFolder(olFolderInbox).Items End Sub Private Sub Items_ItemAdd(ByVal Item As Object) If TypeOf Item Is Outlook.MailItem Then Dim sPath As String Dim dtDate As Date Dim sName As String Dim enviro As String enviro = CStr(Environ("USERPROFILE")) sName = Item.Subject ReplaceCharsForFileName sName, "_" dtDate = Item.ReceivedTime sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _ vbUseSystem) & Format(dtDate, "-hhnnss", _ vbUseSystemDayOfWeek, vbUseSystem) & "-" & sName & ".msg" ' use My Documents for older Windows. sPath = enviro & "\Documents\" Debug.Print sPath & sName Item.SaveAs sPath & sName, olMSG End If End Sub Private Sub ReplaceCharsForFileName(sName As String, _ sChr As String _ ) sName = Replace(sName, "/", sChr) sName = Replace(sName, "\", sChr) sName = Replace(sName, ":", sChr) sName = Replace(sName, "?", sChr) sName = Replace(sName, Chr(34), sChr) sName = Replace(sName, "<", sChr) sName = Replace(sName, ">", sChr) sName = Replace(sName, "|", sChr) End Sub
Run a Script Rule
This version of the macro is a "Run a Script" macro and used in a Rule. When a message arrives meeting the conditions in the rule, the script runs and saves the message. You can create a rule containing no conditions, if you want it to use the script on all messages.
For best results, all Rule Actions need to be in the script. The rule should contain only conditions.
Public Sub SaveMsg(Item As Outlook.MailItem) Dim sPath As String Dim dtDate As Date Dim sName As String Dim enviro As String enviro = CStr(Environ("USERPROFILE")) sName = Item.Subject ReplaceCharsForFileName sName, "_" dtDate = Item.ReceivedTime sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _ vbUseSystem) & Format(dtDate, "-hhnnss", _ vbUseSystemDayOfWeek, vbUseSystem) & "-" & sName & ".msg" ' use My Documents in older Windows. sPath = enviro & "\Documents\" Debug.Print sPath & sName Item.SaveAs sPath & sName, olMsg End Sub Private Sub ReplaceCharsForFileName(sName As String, _ sChr As String _ ) sName = Replace(sName, "/", sChr) sName = Replace(sName, "\", sChr) sName = Replace(sName, ":", sChr) sName = Replace(sName, "?", sChr) sName = Replace(sName, Chr(34), sChr) sName = Replace(sName, "<", sChr) sName = Replace(sName, ">", sChr) sName = Replace(sName, "|", sChr) End Sub
How to use macros
First: You will need macro security set to low during testing.
To check your macro security in Outlook 2010 or 2013, go to File, Options, Trust Center and open Trust Center Settings, and change the Macro Settings. In Outlook 2007 and older, itâs at Tools, Macro Security.
After you test the macro and see that it works, you can either leave macro security set to low or sign the macro.
Open the VBA Editor by pressing Alt+F11 on your keyboard.
To put the code in a module:
- Right click on Project1 and choose Insert > Module
- Copy and paste the macro into the new module.
More information as well as screenshots are at How to use the VBA Editor
Diane,
I have added several different email addresses to Outlook. How could I modify this code to so that instead of saving messages arriving to the default inbox, it saves messages arriving to a different email address that is not the default?
thank you a lot you saved my day, can i ask for one more thing i need to move the mail item after saving to archive folder but i failed to do so if you can help that will be fantastic.
I have attempted to use the ItemAdd in ThisSessionOutlook, but I keep getting an this error message:
"Run-time Error '-2147287037 (80030003)':
The operation failed."
When I select to debug, it highlights this line:
Item.SaveAs sPath & sName, olMsg
Any ideas why I am getting this message?
Thanks,
Brian
Hi, Thank you for your macro. How to modify the script if I want to have the sender name in the Exported msg ?
Date-Time-Sender-Subject.msg ?
Thank you
Love this!! Think its almost exactly what I need! Thank you!
However, I'm getting a bug when I run it.
I am trying to put the vba as suggested above but save the message in a newly created folder which also has the same name:
strNewFolderName = Format(dtDate - 1, "yyyymmdd", vbUseSystemDayOfWeek, _
vbUseSystem)
I use Mkdir command to create a folder.
When I specify the path with this variable where I want to save the message the script is not working:
sPath = enviro & "\Documents\" & strNewFolderName
Debug.Print sPath & sName
Item.SaveAs sPath & sName, olMSG
Can you please help why it is not saving in a folder just created?
Thanks
Does the debug.print show the correct path? (Yo might need a & "\" at the end of sPath.
How do I modify the code so it limits the number of characters in the email subject? I've been successful in moving emails to a SharePoint document library but get a runtime error when the subject is too long, which I think is due to the library column's character limit.
When you create the name use sname = left(sname, 10) where 10 is the number of letters.
Prior to posting my question, I tried this on the different instances sName occurred throughout the code, but it didn't work. I guess I just missed the line where I should have defined it. It works now. Thanks for the prompt reply.
You aren't alone - a lot of people miss/forget to enter valid paths...
hi Diane
I have added to the code and it works perfectly when i manually drag the email with attachment to the specified folder but the itemAdd fails to be triggered when I use a rule to move the email into the specified folder.
Our group policy prevents us from using run a script in the rule.
Can you please help??
Many thanks
>> Our group policy prevents us from using run a script in the rule.
They let you use macros but not script rules? that doesn't make a lot of sense. :) If you use 2013 or 2016, it's possible run a script was disabled by an update - but gpo is probably blocking you from restoring that https://www.slipstick.com/outlook/rules/outlook-2016-run-a-script-rules/
itemadd should definitely be triggered when messages move - and as long the itemadd doesn't use an if statement to filter the mail, it should work from the rule.
Hmmm. is the rule a server side rule? it shouldn't matter, but i wonder if moving the message on the server is causing outlook/the macro to not deleted the added item.