Tutorial - Outlook archive macro to save email as text, format the filename and then delete the message.

Posted: 09/10/2013

This is a simple tutorial that you can setup in Outlook that will help you create a macro that will archive the contents of an open email as a text file with a formatted filename somewhere on your file system or network. This is pretty basic, no bells and whistles. I used it as a way to help me archive messages quickly (in my case, I don’t care about or am I handling attachments). For this tutorial we are going to add a macro and a button via the open message dialog (when you double click on an item from your inbox).

Step 1

If the Developer tab on the Ribbon isn’t showing on the message dialog, right click on the ribbon and choose “Customize the Ribbon”. On the right hand side, find the “Developer” item and make sure it’s checked. After it is, click “OK”

Step 2

Click on the “Developer” tab and then click “Visual Basic”. On the left hand side in your project explorer right click and insert a new Module (if the Modules folder exists do it there). Now that you’ve inserted a new Module file (probably named Module1) paste the below code into the module. You will see that I hard coded a location at the bottom of the script, you will want to change where that goes (or make the script more robust and ask for the location via a dialog or pull it from a settings file, etc.). Be sure to save.

In this script I set the format of the email to be something like “2013-09-10 – Blake Pell – This is a test email subject.txt”. I then strip out some characters that are problematic. This works but I haven’t tested it thoroughly as I just wrote it over this past weekend (I will try to update this post as I find problems with it).

VBA (Visual Basic for Applications)

    Sub SaveEmailAsText()
        Dim item As Outlook.MailItem
        Set item = Outlook.ActiveInspector.CurrentItem
        Dim fileName As String

        Dim strYear As String
        Dim strMonth As String
        Dim strDay As String

        strYear = year(item.SentOn)
        strMonth = month(item.SentOn)
        strDay = day(item.SentOn)

        If Len(strMonth) = 1 Then
            strMonth = "0" & strMonth
        End If

        If Len(strDay) = 1 Then
            strDay = "0" & strDay
        End If

        fileName = strYear & "-" & strMonth & "-" & strDay & " - "
        fileName = fileName & item.Sender & " - "
        fileName = fileName & item.Subject
        fileName = fileName & ".txt"

        'Remove special chars
        fileName = Replace(fileName, "", "")
        fileName = Replace(fileName, "/", "")
        fileName = Replace(fileName, ":", "")
        fileName = Replace(fileName, "*", "")
        fileName = Replace(fileName, "?", "")
        fileName = Replace(fileName, ">", "")
        fileName = Replace(fileName, "<", "")

        'Save to a file
        item.SaveAs "E:FilesEmail Archive" & fileName, olTXT

    End Sub

Step 3

Right click the ribbon again and choose “Customize the Ribbon”. Select the “Message” section on the right hand side and click “New Group”. Name the group something like “My Macros”. Now, on the left hand side under “Choose commands from:” select Macros and you should see your macro in the list. Click on it and then click the “Add” button to move it over to the Message section. From there, you can select it and rename it or give it a custom icon. I named mine “Archive Email” since I was saving it and then deleting it.

That’s it! It’s a quick and easy way to automate archiving of emails to a text file via an Outlook macro.

Additional Info

One last snippet. Let’s say that you want to do this same thing but you want to do it from the main window in Outlook and have it archive emails for every item selected. Here is a macro that you can put on the Ribbon there (like you did in the developer). It only works for mail messages and is mostly the same as above other than it gets mail items from the ActiveExplorer and then loops over them.

VBA (Visual Basic for Applications)

    Sub SaveEmailAsTextFromMainGrid()
        Dim exp As Outlook.Explorer
        Dim sel As Outlook.Selection
        Dim item As Outlook.MailItem

        Set exp = Application.ActiveExplorer
        Set sel = exp.Selection

        For x = 1 To sel.Count
            Set item = sel.item(x)

            Dim fileName As String
            Dim strYear As String
            Dim strMonth As String
            Dim strDay As String

            strYear = year(item.SentOn)
            strMonth = month(item.SentOn)
            strDay = day(item.SentOn)

            If Len(strMonth) = 1 Then
                strMonth = "0" & strMonth
            End If

            If Len(strDay) = 1 Then
                strDay = "0" & strDay
            End If

            fileName = strYear & "-" & strMonth & "-" & strDay & " - "
            fileName = fileName & item.Sender & " - "
            fileName = fileName & item.Subject
            fileName = fileName & ".txt"

            'Remove special chars
            fileName = Replace(fileName, "", "")
            fileName = Replace(fileName, "/", "")
            fileName = Replace(fileName, ":", "")
            fileName = Replace(fileName, "*", "")
            fileName = Replace(fileName, "?", "")
            fileName = Replace(fileName, ">", "")
            fileName = Replace(fileName, "<", "")

            'Save to a file
            item.SaveAs "E:FilesEmail Archive" & fileName, olTXT
            ' Now delete it
            item.Delete
        Next x
    End Sub