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

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