There are many reasons that you may want to dump an outlook folder to HTML files. An afternoon of searching lead me to put this macro together.
How to Install It:
In Outlook – Tools, Macro, Visual Basic Editor
In the left column, double-click ThisOutlookSession
Paste the code into the right column
Edit the destination file paths as needed
Click Save
How to Use It:
Open any folder in your Outlook. Click Tools, Macro, Macros…
Run the macro
All emails from the current email folder are dumped to the destination folder as HTMl files and attachment files.
The Code:
The code is borrowed heavily from here but has been adapted for my needs.
Sub ExportToHTML()
‘This code is based on the work of ediscovery, available at ediscovery.wordpress.com
‘The save attachments bit is based on Michael Brederlau’s post on OutlookCode.com
‘To use paste the entire example code into ThisOutlookSession (or other Project) from
‘within the VB editor
‘################################################################
‘WARNING 1: This script cannot cope with anything other than ordinary emails (so no invites, read
‘receipts, delivery receipts etc), ordinary can of course mean any format (HTML, TXT, RTF etc)
‘WARNING 2: This script also won’t work at all if you don’t read through it and change the folder
‘paths to real folders in your system. You have to create the folders before using this script.
‘It is reccomended that you have the attachments folder as a sub folder of the main message folder.
‘################################################################
‘Declare variables
Dim inBox As Outlook.MAPIFolder
Dim objEmail As MailItem
Dim inBoxItems As Outlook.Items
Dim i As Integer
Dim objAttachments As Object
Dim SubjectText As String
Dim SubjectDate As Date
Dim NewSubjectText As String
Dim Length As Integer
Dim Attachments As Integer
Dim Message
‘Set folder you wish to export from – by default this is set as the Active Folder
Set inBox = Outlook.ActiveExplorer.CurrentFolder
‘Get the items from the folder and set to the variable you declared
Set inBoxItems = inBox.Items
‘Sort them by date
inBoxItems.Sort “SentOn”, 1
‘Set loop counter to 1
i = 1
‘For each of the itms in the selected folder
For Each objEmail In inBoxItems
‘We create a new Mail item for each object in the folder
Dim mailObj As MailItem
Set mailObj = objEmail
‘First we check the message format and process accordingly
If (objEmail.BodyFormat = olFormatPlain Or olFormatRichText Or olFormatUnspecified) Then
mailObj.BodyFormat = olFormatHTML ‘Converts body to HTML if not HTML format
End If
‘Then we get the attachments
Set objAttachments = mailObj.Attachments
‘If there are some
If objAttachments.Count > 0 Then
‘for all attachments do…
For Attachments = 1 To objAttachments.Count
‘############################################################
‘EDIT THE LINK HERE OR THIS WON’T WORK
‘By default it links to a sub folder called Attchments
‘############################################################
‘Add name and destination to message text
mailObj.HTMLBody = mailObj.HTMLBody & vbCrLf & Chr(60) & “A HREF=” & Chr(34) & “Attachments\” & Format(i, “0000″) & “, ” & objAttachments(Attachments).DisplayName & Chr(34) & Chr(62) & objAttachments(Attachments).DisplayName & Chr(60) & “/A” & Chr(62) & Chr(60) & “BR” & Chr(62) & vbCrLf
‘Save them to destination
‘###############################################################
‘EDIT THE FOLDER NAMED HERE OR THIS WON’T WORK
‘###############################################################
objAttachments(Attachments).SaveAsFile “C:\HTML-Mail\Attachments\” & Format(i, “0000″) & “, ” & objAttachments(Attachments).DisplayName
Next Attachments
End If
‘Then we check the subject text, and remove and : which will kill the sub
SubjectText = objEmail.Subject
SubjectDate = objEmail.ReceivedTime
Length = 1
NewSubjectText = “”
For Length = 1 To Len(SubjectText)
If (Mid(SubjectText, Length, 1) = Chr(58)) Or (Mid(SubjectText, Length, 1) = Chr(92)) Or (Mid(SubjectText, Length, 1) = Chr(47)) Or (Mid(SubjectText, Length, 1) = Chr(34)) Or (Mid(SubjectText, Length, 1) = Chr(60)) Or (Mid(SubjectText, Length, 1) = Chr(62)) Or (Mid(SubjectText, Length, 1) = Chr(42)) Or (Mid(SubjectText, Length, 1) = Chr(63)) Then
NewSubjectText = NewSubjectText & ” – ”
Else
NewSubjectText = NewSubjectText & Mid(SubjectText, Length, 1)
End If
Next
‘Save the HTML Email
‘################################################################
‘EDIT THE FOLDER NAMED HERE OR THIS SCRIPT WON’T WORK
‘################################################################
mailObj.SaveAs “C:\HTML-Mail\” & Format(i, “0000″) & “, ” & Format(SubjectDate, “dddd mmmm dd yyyy”) & “, ” & NewSubjectText & “.html”, olHTML
‘Counter used to name emails and attachments
i = i + 1
Next
End Sub
