Bulk 'save as' to HTML (2002 SP1)

[bealt]

I use Outlook 2002 with Exchange and would like to keep HTML versions of my emails in an ordinary folder along with the Word documents and Excel spreadsheets that relate to projects I am working on so that my whole electronic files is in one place and accessible to all. I can use the File Save As to save a single email as a HTML file, but you can't highlight multiple files to do this in bulk. I know I could export them as a PST, but then they can't be read like normal files and the PST would need to be redone all the time to update for new emails. Is there a utility available or some other way to bulk export Exchange based emails to HTML files?

[OldDog]

I don't know about the bulk HTML export. But since you are on Exchange you might ask your admin about using public folders. This is a great way to share email - and documents too. One big advantage with these folders is that you see and work with them the same way as in your Outlook folders. You don't get that when you save to a file system. Just a thought...

[SteveRose]

You were after a premade utility, but here is some code to achieve what you want.

To set up:
1. Copy the code from below, and in Outlook, press ALT-F11 to open the code editor, and then paste the code into "ThisOutlookSession". Close the code editor.
2. Back in Outlook, right-click a toolbar and choose customise - on the commands tab scroll down to the category "macros" - on the right you should see our macro (it will say something like "Project1.ThisOutlookSession.bul..."). Drag and drop that item onto a toolbar or position it on a menu. [Later, you can finetune how this displays including changing the visibile caption and an assigning an icon etc]

To use:
Now, select multiple items, and then press the button/menu item. It will prompt you for a location, and then save all the items there.

'----------Start Code----------
Sub BulkSaveOut()
Dim selItems As Outlook.Selection
Dim objItem As Object
Dim x As Long
Dim strPath As String, strFullName As String, strName As String
On Error GoTo myerr

Set selItems = Application.ActiveExplorer.Selection

strPath = InputBox("Where would you like to save the " & selItems.Count & " items selected?" & vbNewLine & "(eg C:MyFiles)", "Bulk Save Utility", "C:temp")
If Len(strPath) > 0 Then 'else they hit cancel
If Right(strPath, 1) = "" Then strPath = Left(strPath, Len(strPath) - 1) 'catch "C:"
For x = 1 To selItems.Count
Set objItem = selItems.Item(x) 'some of the properties used below are mailitem only
If TypeName(objItem) = "MailItem" Then
strName = Format(objItem.SentOn, "yymmdd") & " " & objItem.Subject
Select Case objItem.BodyFormat
Case olFormatHTML
strFullName = strPath & "" & strName & ".htm"
objItem.SaveAs strFullName, olHTML 'olSaveAsType constant for HTML only works if the item is HTML
Case olFormatPlain
strFullName = strPath & "" & strName & ".txt"
objItem.SaveAs strFullName, olTXT
Case olFormatRichText
strFullName = strPath & "" & strName & ".msg"
objItem.SaveAs strFullName
Case olFormatUnspecified
strFullName = strPath & "" & strName & ".msg"
objItem.SaveAs strFullName
End Select
End If
Next x
End If
exit_sub:
Set objItem = Nothing
Set selItems = Nothing
Exit Sub

myerr: 'std
Dim intReturn As Integer
intReturn = MsgBox(Err.Number & " - " & Err.Description, vbAbortRetryIgnore)
Select Case intReturn
Case vbAbort
GoTo exit_sub
Case vbRetry
Resume
Case vbIgnore
Resume Next
End Select
End Sub
'----------end code----------