title: Saving Message to Hard Drive with Outlook subfolder name in filename
body: <p>I file my Outlook emails into <em>subfolders</em>. I would like to archive them by saving them to my hard drive.</p>
  <p>I found code which is saving the message name as date and time, plus sender, plus subject.</p>
  <p>I would like to add the <em>subfolder</em> name in the file name when it is saved.</p>
  <pre><code>Option Explicit
  Public Sub SaveMessageAsMsg()
      Dim oMail As Outlook.MailItem
      Dim objItem As Object
      Dim sPath As String
      Dim dtDate As Date
      Dim sName As String
      Dim enviro As String
      Dim sSender As String
      Dim sCategory As String
                    
      enviro = CStr(Environ(&quot;USERPROFILE&quot;))
    
      For Each objItem In ActiveExplorer.Selection
          If objItem.MessageClass = &quot;IPM.Note&quot; Then
              Set oMail = objItem
  
              sName = oMail.Subject
              ReplaceCharsForFileName sName, &quot;-&quot;
  
              sSender = oMail.SenderName
  
              sCategory = oMail.Categories
       
              dtDate = oMail.ReceivedTime
              sName = Format(dtDate, &quot;yyyy-mm-dd&quot;, vbUseSystemDayOfWeek, _
                vbUseSystem) &amp; Format(dtDate, &quot;--hhnn&quot;, _
                vbUseSystemDayOfWeek, vbUseSystem) &amp; &quot; -- &quot; &amp; sCategory &amp; _
                &quot; -- &quot; &amp; sSender &amp; &quot; -- &quot; &amp; sName &amp; &quot;.msg&quot;
  
              sPath = enviro &amp; &quot;\Documents\Emails\&quot;
              Debug.Print sPath &amp; sName
              oMail.SaveAs sPath &amp; sName, olMSG
  
          End If
      Next
  
  End Sub
  
  Private Sub ReplaceCharsForFileName(sName As String, _
    sChr As String _
  )
    sName = Replace(sName, &quot;'&quot;, sChr)
    sName = Replace(sName, &quot;*&quot;, sChr)
    sName = Replace(sName, &quot;/&quot;, sChr)
    sName = Replace(sName, &quot;\&quot;, sChr)
    sName = Replace(sName, &quot;:&quot;, sChr)
    sName = Replace(sName, &quot;?&quot;, sChr)
    sName = Replace(sName, Chr(34), sChr)
    sName = Replace(sName, &quot;&lt;&quot;, sChr)
    sName = Replace(sName, &quot;&gt;&quot;, sChr)
    sName = Replace(sName, &quot;|&quot;, sChr)
  End Sub
  </code></pre>