Sub SaveSelectedMailBodiesTxtFiles()
  
  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
    Dim fso As New FileSystemObject
    Dim ts As TextStream


  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"
  
 ' you need to checkmark Microsoft Sripting Runtime in Tools, References 
  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
 
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