Save outlook mail into individual .txt files in to system folder

Question

I tried to save Outlook mail to a system folder in .txt format. After running the macro I am not able to see any files in the system folder.

I am not getting any result in the I:\Documents folder.

Sub SaveSelectedMailAsTxtFile()
  Const OLTXT = 0
  Dim currentExplorer As Explorer
  Dim Selection As Selection
  Dim oMail As Outlook.MailItem
  Dim obj As Object
  Dim sPath As String
  Dim dtDate As Date
  Dim sName As String

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

  For Each obj In Selection
    Set oMail = obj
    sName = oMail.Subject
    ReplaceCharsForFileName sName, "_"

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

    oMail.SaveAs "I:\Documents" & sName & ".txt", OLTXT
  Next

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

Answer 1

' General Declarations
Option Explicit

' Public declarations
Public Enum olSaveAsTypeEnum
  olSaveAsTxt = 0
  olSaveAsRTF = 1
  olSaveAsMsg = 3
End Enum

Sub Export_MailasMSG()
' Routine will take all selected mails and export them as .MSG files to the
' directory defined by
' Error Handling
On Error Resume Next

' Varaiable Declarations
Dim objItem As Outlook.MailItem
Dim strExportFolder As String: strExportFolder = "I:\Documents\"
Dim strExportFileName As String
Dim strExportPath As String
Dim strReceivedTime As String
Dim strSubject As String
Dim objRegex As Object

' Initiate regex search
Set objRegex = CreateObject("VBScript.RegExp")
With objRegex
.Pattern = "(\s|\\|/|<|>|\|\|\?|:)"
.Global = True
.IgnoreCase = True
End With

' Check if any objects are selected.
If Application.ActiveExplorer.Selection.Count = 0 Then
   MsgBox ("No item has been selected.")
Else
    ' Cycle all selected objects.
    For Each objItem In Application.ActiveExplorer.Selection
        ' If the currently selected item is a mail item we can proceed
        If TypeOf objItem Is Outlook.MailItem Then
            ' Format the file name
            strReceivedTime = objItem.ReceivedTime
            strSubject = objItem.Subject
            strExportFileName = Format(strReceivedTime, "yyyymmdd", vbUseSystemDayOfWeek, _
                    vbUseSystem) & Format(strReceivedTime, "-hhnnss", _
                    vbUseSystemDayOfWeek, vbUseSystem) & "-" & strSubject
            strExportFileName = objRegex.Replace(strExportFileName, "_")
            ' Export to the predefined folder.
            strExportPath = strExportFolder & strExportFileName & ".txt"
            objItem.SaveAs strExportPath, olSaveAsTxt
            MsgBox ("Email saved to: " & strExportPath)
        Else
            ' This is not an email item.
        End If
    Next 'objItem
End If



' Clear routine memory
Set objItem = Nothing
Set objRegex = Nothing

End Sub

Here is code i use for this. It will take all selected emails and export them as txt files into the folder specified by strExportFolder. It also does some validation of how many items are selected and if they are emails. I use the enum olSaveAsTypeEnum to selected between msg and txt. I usually use txt but for your case i was able to change it to txt easily since i had the enum setup. I replace the sub ReplaceCharsForFileName with a regex replace command.

You should be able to insert your date manipulation code to suit your needs.

EDIT: I have updated the code to include your method of creating timestamps. I tried this on a series of emails and i can see all the txt files just fine after selecting about 7. If this still does not work i would need to see the subject and time of some of your emails as well as the file names of the ones you "see". The above code works for me now as i believe you intended it to.

I will not be able to do much testing beyond this as i do not have your source data to play with.