Outlook export to HTML
Click here for a text file of this script, description below
This script has now been superceeded by my Full Outlook Archive script, however it does help show how the larger script works so I have kept it.
I wrote this macro to solve a specific problem I had. As part of my work I keep copies of almost all emails (I work in a safety critical evironment as an Engineer) I am sent or send. Of course after a while my allocated space on the Exchange server would fill up, so I export all old emails and save them as PST's.
After a while I decided to take all my backups (Gb of images, emails and documents) and create an indexed data archive, using Google Desktop under windows and Beagle under Linux, however I disovered that even Google Desktop can't index Outlook PST's unless the PST's are opened in Outlook (nothing at all on Linux can open them). Not ideal with 6 years of emails.
The solution was to write this script, which exports all the emails in your inbox as HTML, and will also extract the attachments, rename them by the number of the email, and the original name, and then add a link back to the html email you just exported. This is also useful if you want to empty out your gmail account, but still keep the emails in an indexable form (just download your entire GMail account, enable "remove from server when deleted", export the inbox and then delete what you don't want anymore).
Please note that this script isn't totally automatic, start by pasting the code into a new Macro project (such as ThisOutlookSession), then edit the highlighted areas which contain paths to the export folders. These folders must be created before you run the Macro; for simplicity create one main email folder, and a sub folder called Attachments (the link insterted for the attchments points to a relative folder called Attchments within the main message folder) and then just edit the two areas highlighted, rather than also having to edit the line which creates the html link.
Outlook export emails and attchments to HTML
At the top of this page is a link to a text file of this Macro. If you are opening this on a Windows machine you may have to use Wordpad rather than Notepad to open the text file as it may have been saved in Unix format.
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 Inbox only
Set inBox = Me.ActiveExplorer().Session.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
'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:\Documents and Settings\Ed\My Documents\Outlook\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:\Documents and Settings\Ed\My Documents\Outlook\" & 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