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 path you 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
Can anybody have a video for this task..If so please share it
Hi Diane,
Maybe I missed it but is there a setting I can set to allow me to default to .txt when saving a message as a file or possibly saving as last format used?
You didn't miss anything - its not an option. Sorry.
Hi Diane,
I am working on creating email from an Outlook template (.oft) file. The same has FomatText property as 'HTML'. The template is used to insert an image & necessary body (which includes tables; bullet points). I am facing issues with NewMessage.saveAs(path\filename&".msg", olMsg) statement. The issue is that it saves the filename.msg as plain 'TEXT'. The image is not visible and none of the formats i.e. bullets/table are visible. If I place NewMessage.display before/after 'saveAs' statement I can see the email generated as required i.e. with HTML content intact.
Can you please help me with suggestions as to what is going wrong in above line.
Hi Diane, I have been using your code "Save selected message as a text file", but I want to save each email received and not the selected. you could help me? I understand this part define here "Set Omail = Application.ActiveExplorer.Selection.Item (1)" ?
First of all, thank you verry mutch. I have been using your code to save all mails in a selection as text file. I only have one problem that i can't solve. If i run the macro on Outlook 2010, there is no problem. But i still have one system that works with Outlook 2003 and for some reason, the macro stops after 50 messages, no mather what the selection is
Hi, I want to save all the mails from the same day with their date, is there a way to select mails with the current date in the vb script and then use those selected emails as above ?
I'm not sure what you want to do - the macro adds the received date to the saved file subject.
Hi Diane, thanks for the code, I'm using this code in outlook 2013 after building the rule from specific email address and using run script option. Only caveat is that I have to always select an email and run the rules to save that email to .txt file, is there a way that script can run automatically and save all the emails from that particular email address to .txt file. Thanks in advance for your reply.
Hi Diane,
Thanks for your code, very helpful! It has gotten me about halfway to my goal but hoping you can help me with the rest. I want to save all emails as they come into a specific folder as text files. The folder is at the same level as my Inbox folder. Do you mind explaining me how to do this? I'm new to VBA so all examples and explanations are very appreciated.
This will get you a folder at the same level as the inbox
Set myfolder = Session.GetDefaultFolder(olFolderinbox).Parent.Folders("folder name")
Thanks Diane! For some reason, the code I'm working with still doesn't work. Can you find anything wrong with the VBA below? The goal of the code is to take all emails going to the Picklists folder to save as text files to my USQ Text Files folder.
Sub Application_Startup()
Dim Ns As Outlook.NameSpace
Set Ns = Application.GetNamespace("MAPI")
Set Items = Ns.GetDefaultFolder(olFolderInbox).Items
Set myFolder = Session.GetDefaultFolder(olFolderInbox).Parent.Folders("Picklists")
End Sub
Sub Items_ItemAdd(ByVal Item As Object)
If TypeOf Item Is Outlook.MailItem Then
SaveMailAsFile Item
End If
End Sub
Sub SaveMailAsFile(oMail As Outlook.MailItem)
Dim dtDate As Date
Dim sName As String
Dim sFile As String
Dim sExt As String
sPath = "\antdeptPrimeNow3PAcctMgmtNYCUSQ Text Files"
sExt = ".txt"
sName = oMail.Subject
ReplaceCharsForFileName sName, "_"
dtDate = oMail.ReceivedTime
sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
vbUseSystem) & Format(dtDate, "-hhnnss", _
vbUseSystemDayOfWeek, vbUseSystem) & "-" & sName & sExt
oMail.SaveAs sPath & sName, olSaveAsMsg
End Sub
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)
End Sub
I think it's this -
Set Items = Ns.GetDefaultFolder(olFolderInbox).Items
Set myFolder = Session.GetDefaultFolder(olFolderInbox).Parent.Folders("Picklists")
This line: Sub Items_ItemAdd(ByVal Item As Object) is looking for the objects defined as items - which is the inbox.
Change those two lines to this and try it.
Set Items = Ns.GetDefaultFolder(olFolderInbox).Parent.Folders("Picklists").Items
Thank you once again! I'm clicking play in VBA to run this macro and see no results, nothing happens. I've used the SaveSelectedMailAsTxtFile macro before so I know the trust setting are enabled. Not sure why I can't see any results in my folder path. Do you have any idea?