Save all Outlook Mail Items to Separate Files
This code will traverse all Outlook folders and save each mail item as an individual file keeping the folder structure. The code is very basic without a user interface. It’s a simple example of how email messages can be stored individually instead of one big pst file for example.
Someone I know wanted to store his email messages as individual files and not in one large file as done by the export functionality of Outlook. This code will do just that.
Using the Code
When Visual Basic editor is opened in Outlook and the code below is copy-pasted into it, this can immediately run and will store all mail items from the inbox to the C:\Temp folder. The method to start is
SaveAllMail. If the immediate window is opened, it will also give some progress feedback.
Option Explicit Const PATHSEPARATOR = "\" Const MAIL_DIRECTORY = "C:\Temp" Const MAIL_SAVETYPE = olMSG ' olHTML, olMSG, olRTF, olTemplate, 'olDoc, olTXT, olVCal, olVCard, olICal, or olMSGUnicode. Const MAIL_SAVEFILE_EXT = ".msg"
- MAIL_DIRECTORY – Directory where the items are saved
- MAIL_SAVETYPE – File type of the saved mail item
- MAIL_SAVEFILE_EXT – File extension of the saved mail item
These constants define how the mail items are stored where the values for MAIL_SAVETYPE and MAIL_SAVEFILE_EXT are related to each other. When, for example, the MAIL_SAVETYPE is changed to olHTML, the value for MAIL_SAVEFILE_EXT should also be changed so it will match the output file format. In the case of olHTML, this should of course be “.htm” (or “.html” if you like).
Public Sub SaveAllMail() ' Save all mail items in the inbox folder ProcessFolder ThisOutlookSession.Session.GetDefaultFolder(olFolderInbox), _ MAIL_DIRECTORY, True ' The line below would scan all outlook folders. 'ProcessFolders ThisOutlookSession.Session.Folders, MAIL_DIRECTORY, True End Sub
SaveMailItem is the main method in this example. The current starting point is the inbox folder. Because this is a single folder, the
ProcessFolder is called. The second start point that is currently commented must be used for a collection of folders.
As an example, when only the subfolders of the inbox must be stored but not the mail items in the inbox itself, the following could be used:
ProcessFolder ThisOutlookSession.Session.GetDefaultFolder(olFolderInbox).Folders, _ MAIL_DIRECTORY, True Public Sub ProcessFolder(Folder As Outlook.Folder, ByVal Directory As String, _ ByVal Recursive As Boolean) Dim FolderDirectory As String FolderDirectory = Directory & PATHSEPARATOR & Folder.Name CreateDirectory FolderDirectory DebugPrint Folder.Name ProcessItems Folder.Items, FolderDirectory If Recursive Then ProcessFolders Folder.Folders, FolderDirectory, Recursive End If End Sub Public Sub ProcessFolders(Folders As Outlook.Folders, _ ByVal Directory As String, ByVal Recursive As Boolean) Dim Folder As Outlook.MAPIFolder For Each Folder In Folders ProcessFolder Folder, Directory, Recursive Next End Sub
The two methods above handle the folder and folders that are found. The functions call each other recursively (if the
Recursive parameter is
true) in a way that each folder will traverse all subfolders and each folder in these subfolders is the point where this recursively starts over again.
Private Sub PrintMailItemsProcessed(NumOfProcessedItems As Long) DebugPrint " Mail items processed: " & CStr(NumOfProcessedItems) End Sub
PrintMailItemsProcessed method above is simply used for printing the processed mail items to the debug window.
Private Sub ProcessItems(Items As Outlook.Items, ByVal Directory As String) Dim Item As Object, MailItemNumber As Long MailItemNumber = 0 DebugPrint " Total number of items: " & CStr(Items.Count) For Each Item In Items Select Case True Case TypeOf Item Is Outlook.MailItem MailItemNumber = MailItemNumber + 1 MailItemToFile Item, Directory, MailItemNumber If (MailItemNumber And 7) = 7 Then PrintMailItemsProcessed MailItemNumber End If Case TypeOf Item Is Outlook.ContactItem ' ... Case TypeOf Item Is Outlook.MeetingItem ' ... Case TypeOf Item Is Outlook.JournalItem ' ... Case Else ' ... End Select Next PrintMailItemsProcessed MailItemNumber End Sub
ProcessItems method is where the items are identified and a specific method for that item can be called. Only the
MailItem is currently processed, but some other item types are identified but are left empty. There are even more item types that aren’t identified in this example.
Private Sub MailItemToFile(Item As Outlook.MailItem, _ ByVal Directory As String, ItemNumber As Long) Item.SaveAs Directory & PATHSEPARATOR & CStr(ItemNumber) _ & " - " & ReplaceIllegalChars(Item.Subject) & MAIL_SAVEFILE_EXT, MAIL_SAVETYPE End Sub
MailItemToFile method will store a given mail item to the corresponding directory in the defined format. The method doesn’t save the attachments to files but this is something that one could easily add him/herself. Just traverse the attachments of the
mailitem and store each attachment to a given location, something like the example below:
For Each Item In Item.Attachments Atmt.SaveAsFile Directory & PATHSEPARATOR & CStr(ItemNumber) & " " & & Atmt.FileName Next Atmt '----------------------------------------------------------------------------------------- ' Some general methods used '----------------------------------------------------------------------------------------- Private Sub DebugPrint(ByVal DebugMessage As String) Debug.Print DebugMessage DoEvents End Sub
DebugPrint method simply will print some information to the immediate window and a
DoEvents call is added to prevent Outlook from “Not responding”.
Public Sub CreateDirectory(ByVal Directory As String) If Dir(Directory, vbDirectory) = vbNullString Then MkDir Directory End If End Sub
' This function will replace all illegal characters with the ReplaceChar Private Function ReplaceIllegalChars(S As String, _ Optional ReplaceChar As Byte = 32) As String Dim index As Integer, CharArray() As Byte, ResultArray() As Byte If Len(S) > 0 Then CharArray = StrConv(S, vbFromUnicode) ReDim ResultArray(UBound(CharArray)) For index = 0 To UBound(CharArray) Select Case Chr(CharArray(index)) Case "/", "\", ":", "?", "*", "<", ">", "|", """" ResultArray(index) = ReplaceChar Case Else ResultArray(index) = CharArray(index) End Select Next ReplaceIllegalChars = StrConv(ResultArray, vbUnicode) Else ReplaceIllegalChars = vbNullString End If End Function
ReplaceIllegalChars will strip the characters from a given
string that aren’t allowed in a filename and is used in this example to strip illegal characters from the mail subject before using it as filename. The character will be replaced with the one given in the
ReplaceChar parameter. This must be a single byte value that represents the ASCII value of the character. The built-in
Asc function can be used in this case to convert the character to the ASCII value.
When looking into the code of this function, you may notice that
S is converted to a byte array and an equivalent array is defined to hold the result. In this way, the memory needed can be allocated at once instead of adding just one character at a time. This method of processing characters in a
string is notably faster when dealing with large
Points of Interest
This example is, as mentioned at the beginning, very basic and something you can extend easily to provide functionality for all your wishes. It’s a working starting point for exploring other possibilities Outlook has and that perhaps could make your life a bit easier by automating it.