如何解析Outlook邮件项信息并将选定邮件保存至指定文件夹？

需求：选取Outlook中已选中的邮件，解析其收件日期、发件人、收件人及主题，用这些元素生成合法文件名，最终将邮件保存为.msg格式到指定文件夹。以下是对原代码的修正和解析：

原代码存在的问题 #

• mSubject 类型定义错误：主题是文本内容，应声明为 String 而非 Long
• 收件人获取方式错误：oMail.Recipients 是集合对象，无法直接赋值给字符串变量，需遍历拼接
• 选中项引用错误：myOlSel.Item 需指定索引（如 Item(1)），若处理多选中邮件需循环遍历
• 缺少文件名合法性处理：邮件主题、日期中可能包含文件名非法字符（如 \/:*?"<>|），需替换
• 缺少保存为.msg的核心逻辑

修正后的完整代码 #

Sub Save_Selected_Messages()
    Dim myOlExp As Outlook.Explorer
    Dim myOlSel As Outlook.Selection
    Dim oMail As Outlook.MailItem
    Dim i As Integer
    
    ' 指定保存路径，可自行修改
    Dim savePath As String
    savePath = "C:\SavedEmails\"
    
    ' 确保保存文件夹存在
    If Dir(savePath, vbDirectory) = "" Then
        MkDir savePath
    End If
    
    Set myOlExp = Application.ActiveExplorer
    Set myOlSel = myOlExp.Selection
    
    ' 遍历所有选中的邮件
    For i = 1 To myOlSel.Count
        If TypeName(myOlSel.Item(i)) = "MailItem" Then
            Set oMail = myOlSel.Item(i)
            
            ' 解析邮件信息
            Dim mSender As String
            Dim mRecipients As String
            Dim mDateStr As String
            Dim mSubject As String
            Dim fileName As String
            
            ' 发件人名称
            mSender = oMail.SenderName
            ' 格式化收件日期为合法文件名格式（替换冒号为横线）
            mDateStr = Format(oMail.ReceivedTime, "yyyy-mm-dd hh-mm-ss")
            ' 遍历收件人集合，拼接收件人名称
            Dim recip As Outlook.Recipient
            For Each recip In oMail.Recipients
                mRecipients = mRecipients & recip.Name & ";"
            Next recip
            ' 移除最后一个分号
            If Len(mRecipients) > 0 Then mRecipients = Left(mRecipients, Len(mRecipients) - 1)
            ' 主题，并替换非法字符
            mSubject = Replace(Replace(Replace(Replace(Replace(Replace(Replace(oMail.Subject, "\", "-"), "/", "-"), ":", "-"), "*", "-"), "?", "-"), """", "-"), "<>", "-")
            
            ' 生成文件名
            fileName = mDateStr & " - 发件人：" & mSender & " - 收件人：" & mRecipients & " - 主题：" & mSubject & ".msg"
            
            ' 保存邮件为.msg文件
            oMail.SaveAs savePath & fileName, olMSG
        End If
    Next i
    
    MsgBox "邮件保存完成！", vbInformation
End Sub

关键解析 #

1. 邮件信息解析

   • 发件人：直接使用 oMail.SenderName 获取显示名称，若需邮箱地址可改用 oMail.SenderEmailAddress
   • 收件日期：用 Format 函数将 ReceivedTime 转换为不含非法字符的字符串格式
   • 收件人：遍历 Recipients 集合，逐个获取收件人名称并拼接，最后移除多余分号
   • 主题：通过多层 Replace 替换所有Windows文件名非法字符，避免保存失败

2. 多选中处理

   • 用 For 循环遍历 myOlSel.Count 所有选中项，通过 TypeName 判断是否为邮件项，避免非邮件类型报错

3. 保存逻辑

   • 先检查目标文件夹是否存在，不存在则创建
   • 使用 SaveAs 方法，指定保存格式为 olMSG（对应.msg文件）

内容的提问来源于stack exchange，提问作者Nick Ku