Vba 如何将Outlook邮件保存为带有类别和其他详细信息的.msg文件？

使用MailItem.SaveAs在Outlook VBA中保存电子邮件很容易

但我看不到任何保存其他详细信息的选项，如作者和类别

第三方程序MessageSave允许以.msg格式保存带有类别和作者的邮件。在Windows资源管理器中，“作者”列和“类别”列显示与Outlook中相同的信息

有人知道如何使用Outlook VBA保存包含这些附加信息的邮件吗？

我买了MessageSave，这是一个很好的程序，但他们不允许在VBA中使用其保存功能。唯一的解决方法是让MessageSave在邮件“到达”特定文件夹时保存邮件。如有必要，我可以使用此功能，但这只是一个解决办法

以下是使用MessageSave保存的电子邮件如何在Windows资源管理器中显示的示例：

---

以下是我遵循的流程：（win7 64）

web搜索“windows vba设置扩展文件属性”

首击：

web搜索：“DSOFile.oledDocumentProperties”

点击microsoft:Dsofile.dll文件允许您在未安装Office时编辑Office文档属性

那不是打字错误。。。它以“when-yo”结尾

下载：DsoFileSetup_KB224351_x86.exe

使用7-zip程序打开DsoFileSetup_KB224351_x86.exe（来自7-zip.org）

将DsoFileSetup_KB224351_x86.exe（使用7-zip）中的dsofile.dll复制到文件夹桌面（在本例中名为“testFiles”）（可能在任何地方…可能是windows system32或syswow64…我只在桌面上尝试过）

以管理员身份打开命令提示窗口

导航到包含dsofile.dll的文件夹

执行以下命令：regsvr32 dsofile.dll

应收到成功确认

启动outlook。。。vba编辑器。。。工具。。。参考资料

并找到“DSO OLE Document Properties Reader 2.1”，然后选中左侧的复选框

返回vba编辑器。。。创建新模块

粘贴以下内容：（这只是一个最小的测试脚本）

将电子邮件“myMessage”从outlook复制（拖放）到文件夹（本例中为桌面上的文件夹）

右键单击文件夹列标题。。。点击更多。。。查找“主题”。。。 单击复选框

运行脚本

“主题”列应在myMessage.msg（或消息的名称）旁边包含“我的主题”

---

也许有一个更简单的方法。。。也许windows PowerShell有一个可以从vba调用的命令

它没有错误检查

不检查重复的邮件名称

不检查非法文件名（除了“：”字符）

只需在任何outlook文件夹中选择一堆电子邮件，然后运行此

' make sure you have a reference to "DSO OLE Document Properties Reader"

Sub extendedProperties()

    Dim msg As mailItem
    Dim objFile As OleDocumentProperties

'   Set objFile = CreateObject("DSOFile.OleDocumentProperties")
    Set objFile = New OleDocumentProperties

    Dim fileName As String
    Dim subjectText As String

    ' !!!!!!!! select a bunch of messages before running this !!!!!!!!

    For Each msg In ActiveExplorer.Selection

        subjectText = Replace(msg.Subject, ":", "_")   ' get rid of illegal file name character (there are others)

        ' adjust the destination folder for your liking
        fileName = "C:\Users\js\Desktop\testFiles\" & subjectText & ".msg"

        Debug.Print fileName

        msg.SaveAs fileName

        objFile.Open fileName
        objFile.SummaryProperties.Subject = "My Subject"
        'objFile.Save
        objFile.Close True     ' save and close   !!!!! duplicate filenames get overwritten !!!!!

'   stop                       ' uncomment this line and the code will stop. press F5 to run, F8 to single-step

    Next msg

    Set msg = Nothing
    Set objFile = Nothing

End Sub

---

Outlook保存项目时，也会保存其他信息。它只是不显示在资源管理器中，因为它都在MSG文件中，而资源管理器也不需要在那里查找。MessageSave似乎还可以设置扩展属性，这是文件系统的一项功能，存储在文件之外。您能在MessageSave创建了一些文件的目录中，在命令行上运行“

dir/r | find”：$DATA”

吗？谢谢您的评论。当我运行该命令时，它不会返回任何文件。当您在资源管理器中打开文件属性时，其他属性是否会显示在任何位置？在哪？我刚刚加了张截图没有。“在资源管理器中打开文件属性时”表示鼠标右键单击->属性。

' make sure you have a reference to "DSO OLE Document Properties Reader"

Sub extendedProperties()

    Dim msg As mailItem
    Dim objFile As OleDocumentProperties

'   Set objFile = CreateObject("DSOFile.OleDocumentProperties")
    Set objFile = New OleDocumentProperties

    Dim fileName As String
    Dim subjectText As String

    ' !!!!!!!! select a bunch of messages before running this !!!!!!!!

    For Each msg In ActiveExplorer.Selection

        subjectText = Replace(msg.Subject, ":", "_")   ' get rid of illegal file name character (there are others)

        ' adjust the destination folder for your liking
        fileName = "C:\Users\js\Desktop\testFiles\" & subjectText & ".msg"

        Debug.Print fileName

        msg.SaveAs fileName

        objFile.Open fileName
        objFile.SummaryProperties.Subject = "My Subject"
        'objFile.Save
        objFile.Close True     ' save and close   !!!!! duplicate filenames get overwritten !!!!!

'   stop                       ' uncomment this line and the code will stop. press F5 to run, F8 to single-step

    Next msg

    Set msg = Nothing
    Set objFile = Nothing

End Sub