使用文件名中的 Outlook 子文件夹名称将邮件保存到硬盘驱动器答案

【问题标题】：Saving Message to Hard Drive with Outlook subfolder name in filename使用文件名中的 Outlook 子文件夹名称将邮件保存到硬盘驱动器
【发布时间】：2020-07-27 15:25:38
【问题描述】：

我将 Outlook 电子邮件归档到 子文件夹。我想通过将它们保存到我的硬盘驱动器来归档它们。

我找到了将邮件名称保存为日期和时间、发送者和主题的代码。

我想在保存时在文件名中添加子文件夹名称。

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("USERPROFILE"))
  
    For Each objItem In ActiveExplorer.Selection
        If objItem.MessageClass = "IPM.Note" Then
            Set oMail = objItem

            sName = oMail.Subject
            ReplaceCharsForFileName sName, "-"

            sSender = oMail.SenderName

            sCategory = oMail.Categories
     
            dtDate = oMail.ReceivedTime
            sName = Format(dtDate, "yyyy-mm-dd", vbUseSystemDayOfWeek, _
              vbUseSystem) & Format(dtDate, "--hhnn", _
              vbUseSystemDayOfWeek, vbUseSystem) & " -- " & sCategory & _
              " -- " & sSender & " -- " & sName & ".msg"

            sPath = enviro & "\Documents\Emails\"
            Debug.Print sPath & sName
            oMail.SaveAs sPath & sName, olMSG

        End If
    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, ":", 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

【问题讨论】：

这是一个很好的例子stackoverflow.com/a/41782997/4539709

标签： vba outlook

【解决方案1】：

如果你已经有一个 Outlook MailItem，你可以通过这样做来获取文件夹名称

FolderName = oMail.Parent.Name

这是因为 Folder 对象是 Outlook 对象模型中 MailItem 的父对象。

【讨论】：

【解决方案2】：

只需将 oMail.Parent.Name 添加到以下行

vbUseSystemDayOfWeek, vbUseSystem) & " -- " & sCategory & " -- " & sSender & " -- " & sName & ".msg"

例子

vbUseSystemDayOfWeek, vbUseSystem) & " -- " & sCategory & " -- " & sSender & " -- " & sName & " -- " & oMail.Parent.Name & ".msg"

See Folder.Name Property (Outlook) MSDN

【讨论】：