Last reviewed on September 20, 2013   —  15 Comments

A visitor to OutlookForums saves messages as text files and was tired of changing the default Save as format to txt.

I save multiple messages everyday as text files. I just upgraded from 2007 outlook to 2010. Before the upgrade I had it defaulted to save as text. I did not do this that I recall it just has been that way. Now that I have upgraded it is defaulted to msg. Please tell me if there is a way to do this as it will save me an immense amount of excess clicking.

This macro is a manual version of E-Mail: Save new items immediately as files. Unlike the original macro, which saves all new messages as text file, you need to select a message and run this macro to save it as a text file.

For other options and utilities, see How to Save Email in Windows File System.

Save selected message as a text file

A version of this macro which saves all selected messages as multiple individual text files is at SaveSelectedMailAsTxtFile. The code sample at SaveSelectedMailBodiesTxtFiles is the modification discussed in this comment and reply.


 Sub SaveMailAsFile()
 Const OLTXT = 0
 Dim oMail As Outlook.mailItem
 Dim sPath As String
  Dim dtDate As Date
  Dim sName As String

  Set oMail = Application.ActiveExplorer.Selection.Item(1)
  sName = oMail.Subject
  ReplaceCharsForFileName sName, "_"

  dtDate = oMail.ReceivedTime
  sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
    vbUseSystem) & Format(dtDate, "-hhnnss", _
    vbUseSystemDayOfWeek, vbUseSystem) & "-" & sName & ".txt"

  oMail.SaveAs "C:\path\to\save\" & sName, OLTXT
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)
End Sub

Save selected messages to a single text file

This code sample saves the selected messages in one text file, replicating Outlook's behavior when you select multiple messages and choose Save as. It uses the current date and folder name as the file name and saves it to the user's My Documents folder.

Sub MergeSelectedEmailsIntoTextFile()

'From http://slipstick.me/fraz6
  
Dim objFS As New Scripting.FileSystemObject, objFile As Scripting.TextStream
Dim objItem As Object, strFile As String
Dim Folder As Folder
Dim sName As String

' Use your User folder as the initial path
Dim enviro As String
enviro = CStr(Environ("USERPROFILE"))

  If ActiveExplorer.Selection.Count = 0 Then Exit Sub
  
' use the folder name in the filename
  Set Folder = Application.ActiveExplorer.CurrentFolder

' add the current date to the filename
sName = Format(Now(), "yyyy-mm-dd")

' The folder pathyou use needs to exist
strFile = enviro & "\Documents\" & sName & "-" & Folder & ".txt"
  
  Set objFile = objFS.CreateTextFile(strFile, False)
  If objFile Is Nothing Then
    MsgBox "Error creating file '" & strFile & "'.", vbOKOnly + vbExclamation _
      , "Invalid File"
    Exit Sub
  End If
  
  For Each objItem In ActiveExplorer.Selection
  
  With objFile
    .Write vbCrLf & "--Start--" & vbCrLf
    .Write "Sender: " & objItem.Sender & " <" & objItem.SenderEmailAddress & ">" & vbCrLf
    .Write "Recipients : " & objItem.To & vbCrLf
    .Write "Received: " & objItem.ReceivedTime & vbCrLf
    .Write "Subject: " & objItem.Subject & vbCrLf & vbCrLf
    .Write objItem.Body
    .Write vbCrLf & "--End--" & vbCrLf
 End With

  Next
  objFile.Close
  
  MsgBox "Email text extraction completed!", vbOKOnly + vbInformation, "DONE!"
  
  Set objFS = Nothing
  Set objFile = Nothing
  Set objItem = Nothing
  
End Sub

Replace the code between strFile = enviro... and objFile.close with the following. To add more fields, add more objFile.Write lines.

strFile = enviro & "\Documents\" & sName & "-" & Folder & ".txt"
Set objFile = objFS.OpenTextFile(strFile, ForAppending, True)
       For Each objItem In ActiveExplorer.Selection
        objFile.Write (objItem.Body)
      Next
        objFile.Close

Super short code

This code is super short and works on the currently open or selected message only. You'll need to GetCurrentItem function to use this macro. You'll need to add a check mark to the Microsoft Scripting Runtime in Tools, References.

Messages are appended to one file.

Public Sub SaveEmailBody()
Dim objMail As MailItem
    Dim fso As New FileSystemObject
    Dim ts As TextStream
    
' get the function at http://slipstick.me/e8mio
    Set objMail = GetCurrentItem()
    Set ts = fso.OpenTextFile("E:\Documents\mailfile.txt", ForAppending, True)

    ts.Write (objMail.Body)
     ts.Close
    Set ts = Nothing
    Set fso = Nothing

End Sub

Comments

  1. danni says

    I'm most interested in the first of these. I managed to get it to work in Outlook 2010, but not in 2013. Is there anything that might be different for 2013?

    • danni says

      Nothing. I click, nothing happens visually, I go look at the folder where I expect the file to be but there's nothing there.
      In 2010: I click, nothing happens visually, but the file does appear in the folder where I expect it to be.
      Not to worry. Must be me doing something wrong.

    • danni says

      Yep, first thing I did. It's set to allow.
      But I'm in a corporate environment, with group policies applied, and the 2013 client I tried it on probably has a different lock-down than my machine. Either that or it's PEBCAK :)
      Thanks for responding.

    • Diane Poremsky says

      It could be policy or user error or something else... here it failed because someone (who shall remain nameless) did not change the file path and C:\path\to\save does not exist on the computer. :)

      You can test to see if it is working at all by adding a msgbox "line 1" at the top of the code and msgbox sName after each line that calls sname. - if you don't get the message boxes, the macro is not running at all. Debug.print would work too... or step into (F8) the macro and see if it hits all the lines.

    • Diane Poremsky says

      You can get just the body but need to do it a little differently as you can't use Saveas. You'll need to grab the oMail.body: strBody = oMail.body then write it to a text file.

      I'll add the code to this page.

    • Diane Poremsky says

      Actually, the last macro - MergeSelectedEmailsIntoTextFile - already does it. Remove the lines that add the subject etc.
      .Write "Recipients : " & objItem.To & vbCrLf
      .Write "Received: " & objItem.ReceivedTime & vbCrLf
      .Write "Subject: " & objItem.Subject & vbCrLf & vbCrLf

      Or, replace the block between strfile and objfile.close with this- this will add mail to the current file.

      strFile = enviro & "\Documents\" & sName & "-" & Folder & ".txt"
      Set objFile = objFS.OpenTextFile(strFile, ForAppending, True)
      For Each objItem In ActiveExplorer.Selection
      objFile.Write (objItem.Body)
      Next
      objFile.Close

  2. Ramesh Govindarajan says

    Thank you. I'm no good at coding, so I understand vaguely what you're saying, but have no clue how to do it.

    So, I appreciate you adding the code here.

    Thanks again.

    • Diane Poremsky says

      You want each message into its own text file?

      add this to the top, under the other dim's
      Dim fso As New FileSystemObject
      Dim ts As TextStream

      Replace the end of that macro with this - starting with the line i have here - you need to go to tools, references and add a check to microsoft scripting runtime. Then select some messages and run. This creates one text file per message.

      sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
      vbUseSystem) & Format(dtDate, "-hhnnss", _
      vbUseSystemDayOfWeek, vbUseSystem) & "-" & sName & ".txt"

      Set ts = fso.OpenTextFile("C:\Users\Diane\Dropbox\" & sName, ForAppending, True)

      ts.Write (oMail.Body)
      ts.Close

      Next
      Set ts = Nothing
      Set fso = Nothing
      end sub

  3. Simon Lukes says

    Thank you so much - the code which saves all selected messages as multiple individual text files saved me literally hours of work.

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.