Save all Outlook Mail Items to Separate Files

• Download source - 1.4 KB

Introduction

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.

Background

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 

The method 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

The 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

The 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

The 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

The 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

The 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 string values.

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.