Use this code to save messages with the date in the filename, retaining the Outlook file structure.
To save selected messages as PDF files, see Save Outlook email as a PDF
This code sample will save all messages in a specific Outlook folder (and any subfolders of the selected folder) in a folder you select on the hard drive. The messages will be in a subfolder of the selected folder, where the subfolder is named for the Outlook folder you selected.
Note: if you select a subfolder of a top-level folder, for example, a subfolder of the Inbox, folder named Inbox needs to exist in path on the hard drive.
The filename format is yyyymmdd_hhmm_subject.msg, as in:
20100422_0319_Inquiry.msg
The filename is set using this code:
StrFile = StrSaveFolder & StrReceived & "_" & StrName & ".msg"
Filenames are limited to 256 characters in length, with the subject trimmed if its too long.
Note that it can take some time to run if the folder contains a lot of messages. Allow about 2 seconds per message, or about 15 minutes for 400 messages.
VBA Code
Click in the code area, press Ctrl+A to select all, Ctrl+C to copy then paste into Outlook's VBA editor. Instructions on using the editor are at How to use Outlook's VBA Editor
Option Explicit Dim StrSavePath As String Sub SaveAllEmails_ProcessAllSubFolders() Dim i As Long Dim j As Long Dim n As Long Dim StrSubject As String Dim StrName As String Dim StrFile As String Dim StrReceived As String Dim StrFolder As String Dim StrSaveFolder As String Dim StrFolderPath As String Dim iNameSpace As NameSpace Dim myOlApp As Outlook.Application Dim SubFolder As MAPIFolder Dim mItem As MailItem Dim FSO As Object Dim ChosenFolder As Object Dim Folders As New Collection Dim EntryID As New Collection Dim StoreID As New Collection Set FSO = CreateObject("Scripting.FileSystemObject") Set myOlApp = Outlook.Application Set iNameSpace = myOlApp.GetNamespace("MAPI") Set ChosenFolder = iNameSpace.PickFolder If ChosenFolder Is Nothing Then GoTo ExitSub: End If BrowseForFolder StrSavePath Call GetFolder(Folders, EntryID, StoreID, ChosenFolder) For i = 1 To Folders.Count StrFolder = StripIllegalChar(Folders(i)) n = InStr(3, StrFolder, "\") + 1 StrFolder = Mid(StrFolder, n, 256) StrFolderPath = StrSavePath & "\" & StrFolder & "\" StrSaveFolder = Left(StrFolderPath, Len(StrFolderPath) - 1) & "\" If Not FSO.FolderExists(StrFolderPath) Then FSO.CreateFolder (StrFolderPath) End If Set SubFolder = myOlApp.Session.GetFolderFromID(EntryID(i), StoreID(i)) On Error Resume Next For j = 1 To SubFolder.Items.Count Set mItem = SubFolder.Items(j) StrReceived = Format(mItem.ReceivedTime, "YYYYMMDD-hhmm") StrSubject = mItem.Subject StrName = StripIllegalChar(StrSubject) StrFile = StrSaveFolder & StrReceived & "_" & StrName & ".msg" StrFile = Left(StrFile, 256) mItem.SaveAs StrFile, 3 Next j On Error GoTo 0 Next i ExitSub: End Sub Function StripIllegalChar(StrInput) Dim RegX As Object Set RegX = CreateObject("vbscript.regexp") RegX.Pattern = "[\" & Chr(34) & "\!\@\#\$\%\^\&\*\(\)\=\+\|\[\]\{\}\`\'\;\:\<\>\?\/\,]" RegX.IgnoreCase = True RegX.Global = True StripIllegalChar = RegX.Replace(StrInput, "") ExitFunction: Set RegX = Nothing End Function Sub GetFolder(Folders As Collection, EntryID As Collection, StoreID As Collection, Fld As MAPIFolder) Dim SubFolder As MAPIFolder Folders.Add Fld.FolderPath EntryID.Add Fld.EntryID StoreID.Add Fld.StoreID For Each SubFolder In Fld.Folders GetFolder Folders, EntryID, StoreID, SubFolder Next SubFolder ExitSub: Set SubFolder = Nothing End Sub Function BrowseForFolder(StrSavePath As String, Optional OpenAt As String) As String Dim objShell As Object Dim objFolder ' As Folder Dim enviro enviro = CStr(Environ("USERPROFILE")) Set objShell = CreateObject("Shell.Application") Set objFolder = objShell.BrowseForFolder(0, "Please choose a folder", 0, enviro & "\Documents\") StrSavePath = objFolder.self.Path On Error Resume Next On Error GoTo 0 ExitFunction: Set objShell = Nothing End Function
How to use this macro
First: You need to have macro security set to low during testing. The macros will not work otherwise.
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.
- 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
More Information
- How to Save Email in Windows File System
- Import Messages from File System into Outlook Folders
- OWA: Save Messages to My Documents
- Save a Message as HTML and Delete the (Annoying) Folder
- Save email message as text file
- Save Outlook Email as a PDF
- Save Selected Email Message as .msg File
- Saving All Messages to the Hard Drive Using VBA
Dear Diane, Excellent work.
this is saving exactly 1 year's email, what if i want to save all the mails starting from the day1.
So it quits after saving all messages within a year? how many messages? There is not a timer itn it, so it might be quitting because of the number of messages and not all resources are released. That usually triggers an error though.
Dear Diane, many thanks for this excellent Macro, it is working like a charm and it is actually very helpful. A question: is there any way to automate the process, like running the Macro every time Outlook starts or at a certain time every day ?
Thank you in advance
Outlook doesn't have a timer, but you can use a reminder to trigger it.
https://www.slipstick.com/developer/code-samples/running-outlook-macros-schedule/
I noticed emails with RE:[SPAM] do not save, can the code be altered to ignore the word [SPAM] to allow saving
Hello Diane,
I tried to run this script and there is an "error message" "'76': Path not found." I tried the option "debug" and the line concerned is: "FSO.CreateFolder (StrFolderPath)".
Do you have a solution for that? This script could be so helpfull and great for me!! I hope it could work.
Thank you so much!
Thank you for a very useful and smoothly running macro!
Love peace and respect!
This script is great, exactly what I was looking for. Thank you! I will note I found 2 issues that I'll try to fix. You may already know about these. If you cancel when asked to select a save folder it will error out rather than handling the exception. If you select a folder in outlook to save and that folder is not a top level folder, ie InBox\NewFolder the script will error out saying the path does not exist. This looks to be because its trying to save in inbox\newfolder initially and hasnt yet created the inbox folder first so it cannot create the folder newfolder and thus it doesnt exist yet. Here's where that happens, I made a few mods so I'm not sure the line number, its around 40-45 and at this point strfolderpath = inbox\newfolder what it needs to do is create inbox then create newfolder in 2 seperate actions. If Not FSO.FolderExists(StrFolderPath) Then FSO.CreateFolder (StrFolderPath) End If Neither are a big deal to me, no impact, but thought I'd mention it. If you're looking for improvements it would be really cool if it gave a progress status of some sort. For me it just puts… Read more »
How can I modify the above to get items off a Microsoft exchange server? Code works as long as its not in exchange server.
It should work with email in any account in Outlook. It won't work with Outlook on the web.
Hello Diane, I have the same problem as Tammy. My outook saves automatically emails to a server and after a couple of weeks they're not automatically visible in the folder. In order to see them I have to manually click on "click here to display more Microsoft Exchange elements" in order to see them (in each folder). So if I run your absolutely excellent macro in a given folder, I have 2 behaviours : if all emails are local, i.e. recent, it works perfectly find if there are some 'older' emails in the folder (i.e. available on the MS exchange server), it won't take them into account. Even if I have refreshed before by clicking on "click here to display more Microsoft Exchange elements" I guess there must be some sort of function/ sub/ procedure in order to simulate this click within the macro itself and hence get all emails. If I run the macro in a folder where all emails are old, and in MS exchange, I get basically no export at all. This is weird but very important for me to sort out, otherwise my export is missing a big lot of emails. Many thanks for your help… Read more »
I have the same issue as Tammy. This macro is great and works just fine. But it only saves items considered as "available offline", i.e. not on Microsoft Exchange server. Those are not saved (although they are here).
Hi Diane, thanks this macro is really great. But I do have the exact same issue as Tammy : it saves well all offline mails, but not those which are stored only on the MS exchange server. Is there a fix for that?
Hello Tammy,
Same problem here. Did you find a solution?