Save each e-mail in folder

[Guest]

Hi-
I'd like to burn about 150 e-mails in a folder to a CD. I'm looking for some
code that will loop through 1 folder and save each e-mail as a *.htm file
into a folder on my desktop. Then I'll burn those htm files to the CD.

If an e-mail has an attachment, it can be disregarded.

Thanks your for help
Jason
Outlook 2003, WinXP

 

[Guest]

Try this macro:

Sub SaveEmailsToDisk()
On Error Resume Next

Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder, objItems As Outlook.Items
Dim objItem As Object
Dim strSavePath As String, objMailItem As Outlook.MailItem

Set objNS = Application.GetNamespace("MAPI")

'Select folder containing e-mails
Set objFolder = objNS.PickFolder
If objFolder Is Nothing Then Exit Sub

strSavePath = "C:\Temp"

'FIND ALL E-MAIL MESSAGES IN THE CURRENT FOLDER
Set objItems = objFolder.Items
For Each objItem In objItems
If objItem.Class = olMail Then
If objItem.Attachments.Count = 0 Then
'only process e-mails without attachments
Set objMailItem = objItem
'Be wary of invalid file name characters in Subject line!
objMailItem.SaveAs strSavePath & objMailItem.Subject &
".htm", OlSaveAsType.olHTML
End If
Set objMailItem = Nothing
Set objItem = Nothing
End If
Next

Set objItems = Nothing
Set objFolder = Nothing
Set objNS = Nothing
End Sub