Last reviewed on January 28, 2015   —  11 Comments

An Outlook user wanted to save all of his messages to his hard drive in *.doc format, so that the messages would be in a universal format and the attachments would stay with the document. While you can do this in Outlook, it takes several steps: you need to open the message, go into Edit mode, change the message format to Rich Text (RTF) and save it. Then use SaveAs to save the message to the hard drive.

Using VBA speeds the process up quite a bit.

To save attachments to your hard drive then open them: Save and Open an Attachment using VBA. To save attachments and remove them from the message, see Save and Delete Attachments from Outlook messages

The code adds the message date and time stamp to the filename, to avoid problems if multiple messages have the same subject. You could also add the sender's name to the filename, if desired. The date and time stamp code was taken from E-Mail: Save new items immediately as files.

Save as Doc Macro

If the folder you want to save the documents to does not exist, create it before running the macro.

To use this code, open the VBA editor using Alt+F11 and paste this code into ThisOutlookSession. Change the path where the documents will be saved. Select a folder and run the macro. All messages within the folder will be saved as a Word document file.


Sub SaveAsDoc()

Dim myolApp As Outlook.Application
Dim aItem As Object

Dim dtDate As Date
Dim sName As String

Set myolApp = CreateObject("Outlook.Application")
Set mail = myolApp.ActiveExplorer.CurrentFolder


For Each aItem In mail.Items
    aItem.BodyFormat = olFormatRichText

'If you want to convert all messages to RTF, uncomment this line. 
'Otherwise, the message format is not changed. 
   ' aItem.Save


sName = aItem.Subject
ReplaceCharsForFileName sName, "_"


dtDate = aItem.ReceivedTime
  sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
    vbUseSystem) & Format(dtDate, "hhnnss", _
    vbUseSystemDayOfWeek, vbUseSystem) & "-" & sName
    
    
aItem.SaveAs "C:\email\" & sName & ".doc", olRTF

Next aItem

End Sub

Private Sub ReplaceCharsForFileName(sName As String, sChr As String )
  sName = Replace(sName, "/", sChr)
  sName = Replace(sName, "\", sChr)
  sName = Replace(sName, ":", sChr)
  sName = Replace(sName, "?", sChr)
  sName = Replace(sName, Chr(34), sChr)
  sName = Replace(sName, "<", sChr)
  sName = Replace(sName, ">", sChr)
  sName = Replace(sName, "|", sChr)
  sName = Replace(sName, "&", sChr)
  sName = Replace(sName, "%", sChr)
  sName = Replace(sName, "*", sChr)
  sName = Replace(sName, " ", sChr)
  sName = Replace(sName, "{", sChr)
  sName = Replace(sName, "[", sChr)
  sName = Replace(sName, "]", sChr)
  sName = Replace(sName, "}", sChr)
End Sub

Save Selected Messages

This version of the macro saves just the selected messages, not every message in the folder.

Sub SaveSelectedAsDoc()
 
Dim currentExplorer As Explorer
Dim Selection As Selection
Dim aItem As Object
Dim dtDate As Date
Dim sName As String

Set currentExplorer = Application.ActiveExplorer
Set Selection = currentExplorer.Selection

For Each aItem In Selection
    aItem.BodyFormat = olFormatRichText
 
'If you want to convert all messages to RTF, uncomment this line.
'Otherwise, the message format is not changed.
   ' aItem.Save
 
sName = aItem.Subject
ReplaceCharsForFileName sName, "_"
 
dtDate = aItem.ReceivedTime
  sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
    vbUseSystem) & Format(dtDate, "hhnnss", _
    vbUseSystemDayOfWeek, vbUseSystem) & "-" & sName
         
aItem.SaveAs "C:\mail\" & sName & ".doc", olRTF
 
Next aItem

Set currentExplorer = Nothing
Set Selection = Nothing
 
End Sub
 
Private Sub ReplaceCharsForFileName(sName As String, sChr As String)
  sName = Replace(sName, "/", sChr)
  sName = Replace(sName, "\", sChr)
  sName = Replace(sName, ":", sChr)
  sName = Replace(sName, "?", sChr)
  sName = Replace(sName, Chr(34), sChr)
  sName = Replace(sName, "<", sChr)
  sName = Replace(sName, ">", sChr)
  sName = Replace(sName, "|", sChr)
  sName = Replace(sName, "&", sChr)
  sName = Replace(sName, "%", sChr)
  sName = Replace(sName, "*", sChr)
  sName = Replace(sName, " ", sChr)
  sName = Replace(sName, "{", sChr)
  sName = Replace(sName, "[", sChr)
  sName = Replace(sName, "]", sChr)
  sName = Replace(sName, "}", sChr)
End Sub



Use an ItemAdd Macro to Save as .Doc

This version of the macro is saves messages as doc files as they are dropped in a folder, either by rules or by dragging the message to the folder. As written, it watches a folder under the Inbox.

Add the ReplaceCharsForFileName sub (from the macro above) at the end of this macro.

Option Explicit
Private objNS As Outlook.NameSpace
Private WithEvents objItems As Outlook.Items

Private Sub Application_Startup()
Dim objFolder As Outlook.folder
Set objNS = Application.GetNamespace("MAPI")
Set objFolder = objNS.GetDefaultFolder(olFolderInbox)
Set objItems = objFolder.Folders("Folder01").Items
Set objFolder = Nothing
End Sub

Private Sub objItems_ItemAdd(ByVal aItem As Object)
 
Dim dtDate As Date
Dim sName As String
 
aItem.BodyFormat = olFormatRichText
 
'If you want to convert all messages to RTF, uncomment this line.
'Otherwise, the message format is not changed.
   ' aItem.Save
 
sName = aItem.Subject
ReplaceCharsForFileName sName, "_"
 
 
dtDate = aItem.ReceivedTime
  sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
    vbUseSystem) & Format(dtDate, "hhnnss", _
    vbUseSystemDayOfWeek, vbUseSystem) & "-" & sName
      
aItem.SaveAs "C:\email\" & sName & ".doc", olRTF
 
End Sub

' put the ReplaceCharsForFileName sub here

Comments

  1. Sus Boyce says

    Bless your heart - thank you very much. this is precisely what I was look for. Thank you for saving me tons of time.

  2. A says

    This is great, but is there a way to delete all attachments from the message before they are saved, therefore creating just the email text as a Word doc? Obviously this can be commented out like the convert to RTF line.

  3. Dwight Huse says

    Diane,
    I had a terrible time getting this to work for me. I kept getting a VBA message box stating, Compile Error: Sub or Function not defined. I struggled for a long time until I realized that I must have captured some stray hidden characters when I copied your code. Once I cleaned up all those hidden characters, your code works great. I was dismayed that a dozen coding sites trying to answer this same VBA error message for others have not been able to identify a simple problem like this.

    Thank you so very much for sharing your code.
    -Dwight

  4. Pete Constantine says

    Diane,

    Thanks for the awesome code!! It works exactly as described and flawlessly. In looking at the code, I am trying to determine if I can apply this to a specific folder; not just the current folder. I imagine it is associated with this particular line :

    "Set mail = myolApp.ActiveExplorer.CurrentFolder"

    However, my very limited knowledge of VBA inhibits my ability to figure it out. Do you have any pointers?

    Thanks again for this.

  5. Jennifer McDonald says

    Hi Diane, you have posted several create codes; however my limited knowledge of VBA is contributing to my errors. I am trying to create a code that will save emails as Word Documents on my hard drive. I am moving the appropriate items to a folder in my inbox named: @SaveAsDoc and I have a folder on my hard drive saved at this path: C:Documents and Settingsjennifer.mcdonald2SaveAsDocOutlookMessages .

    I have tried cutting and pasting the code and renaming the folders, but I think my process is a little more involved since I am already moving the items to a subfolder of the inbox. I found some information that left me to believe I may need to use this: Items.ItemAdd Event . I continue to get an error highlighting "Dim" that states Complie Error: Expected End of Statement. Can you possibly help me?

    Thanks,
    Jennifer

    • Diane Poremsky says

      So you want to save the message as a doc file and move it? Or save it only after it is moved?

      I added an itemadd macro to the article - the folder path assumes a subfolder of the inbox.

  6. Dale says

    Thanks Diane for this slick code. Is there a easy way to also perform this on just "Selected" emails instead of the whole(current) folder . Also if I wanted to add the "from" name to the "doc" name would it be sName=aItem.Subject + From (or is it a comma or seperate line?). Thanks for your help!

    Dale

    • Diane PoremskyDiane Poremsky says

      Yeah - you need to change from this: For Each aItem In mail.Items to For Each aItem In Selection and dim/set the objects. (I'll add a second macro to the page that does that.)

      Dim currentExplorer As Explorer
      Dim Selection As Selection

      Set currentExplorer = Application.ActiveExplorer
      Set Selection = currentExplorer.Selection

      For Each aItem In Selection

Leave a Reply

Please post long or more complicated questions at OutlookForums by Slipstick.com.

If the Post Comment button disappears, press your Tab key.