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() 'Fromhttp://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 athttp://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