如何使用VBA递归解析Outlook电子邮件中的正文数据？

我懂你的困扰——每天收到的业务数据都塞在邮件正文里，不是方便导入的附件，只能靠Excel VBA去扒Outlook的邮件。结合你给出的代码片段，我整理了一套支持递归解析嵌套邮件正文的方案，不管是单封邮件，还是带转发/回复链的嵌套邮件，都能把深层的数据挖出来。

核心思路 #

• 递归的关键是识别邮件正文里的嵌套标记（比如常见的-----Original Message-----分隔线）
• 先解析当前邮件的正文内容，再检查是否存在嵌套的原始邮件，递归调用解析函数处理
• 把所有解析到的数据统一写入Excel的指定工作表中

完整代码示例 #

Sub ParseOutlookEmailsRecursively()
    Dim olApp As Object
    Dim olNamespace As Object
    Dim olFolder As Object
    Dim olMail As Object
    Dim ws As Worksheet
    Dim lastRow As Long
    
    ' 初始化Excel工作表
    Set ws = ThisWorkbook.Sheets("Sheet1") ' 改成你的目标工作表名
    ws.Cells.ClearContents
    ws.Range("A1:F1").Value = Array("邮件主题", "发件人", "收件时间", "解析内容1", "解析内容2", "解析内容3") ' 根据你的数据调整表头
    
    ' 初始化Outlook对象
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If Err.Number <> 0 Then
        Set olApp = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0
    Set olNamespace = olApp.GetNamespace("MAPI")
    
    ' 选择要解析的Outlook文件夹（这里默认选收件箱，你可以改成指定路径）
    Set olFolder = olNamespace.GetDefaultFolder(6) ' 6代表收件箱，其他文件夹编号可查Outlook枚举值
    
    ' 遍历文件夹里的邮件
    For Each olMail In olFolder.Items
        ' 只处理邮件类型（排除会议邀请等）
        If olMail.Class = 43 Then
            lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
            ' 解析当前邮件正文，并递归处理嵌套内容
            ParseEmailBody olMail, ws, lastRow
        End If
    Next olMail
    
    ' 释放对象
    Set olMail = Nothing
    Set olFolder = Nothing
    Set olNamespace = Nothing
    Set olApp = Nothing
    
    MsgBox "邮件解析完成！", vbInformation
End Sub

' 递归解析邮件正文的核心函数
Sub ParseEmailBody(olMail As Object, ws As Worksheet, rowNum As Long)
    Dim bodyText As String
    Dim originalMsgStart As Long
    Dim parsedData As Variant
    
    ' 获取邮件正文（优先用纯文本，避免格式混乱）
    bodyText = olMail.Body
    
    ' 1. 解析当前邮件的正文数据（这里根据你的实际数据格式调整解析逻辑）
    parsedData = ExtractDataFromBody(bodyText)
    
    ' 将解析结果写入Excel
    ws.Cells(rowNum, "A").Value = olMail.Subject
    ws.Cells(rowNum, "B").Value = olMail.SenderName
    ws.Cells(rowNum, "C").Value = olMail.ReceivedTime
    If IsArray(parsedData) Then
        ws.Cells(rowNum, "D").Value = parsedData(0)
        ws.Cells(rowNum, "E").Value = parsedData(1)
        ws.Cells(rowNum, "F").Value = parsedData(2)
    End If
    
    ' 2. 检查是否有嵌套的原始邮件（比如转发/回复的内容）
    originalMsgStart = InStr(bodyText, "-----Original Message-----")
    If originalMsgStart > 0 Then
        ' 提取原始邮件的内容（从分隔线开始到末尾）
        Dim originalBody As String
        originalBody = Mid(bodyText, originalMsgStart)
        
        ' 模拟创建临时邮件对象解析原始内容
        Dim tempMail As Object
        Set tempMail = CreateObject("Outlook.MailItem")
        tempMail.Body = originalBody
        
        ' 递归调用解析函数处理原始邮件
        rowNum = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
        ParseEmailBody tempMail, ws, rowNum
        
        Set tempMail = Nothing
    End If
End Sub

' 根据你的数据格式自定义解析函数
Function ExtractDataFromBody(bodyText As String) As Variant
    Dim dataArr(2) As String
    Dim pos As Long
    
    ' 示例：解析正文里的固定标记字段，你需要根据实际格式修改
    ' 解析字段1
    pos = InStr(bodyText, "关键字1:")
    If pos > 0 Then
        dataArr(0) = Trim(Mid(bodyText, pos + 6, InStr(pos + 6, bodyText, vbCrLf) - pos - 6))
    End If
    
    ' 解析字段2
    pos = InStr(bodyText, "关键字2:")
    If pos > 0 Then
        dataArr(1) = Trim(Mid(bodyText, pos + 6, InStr(pos + 6, bodyText, vbCrLf) - pos - 6))
    End If
    
    ' 解析字段3
    pos = InStr(bodyText, "关键字3:")
    If pos > 0 Then
        dataArr(2) = Trim(Mid(bodyText, pos + 6, InStr(pos + 6, bodyText, vbCrLf) - pos - 6))
    End If
    
    ExtractDataFromBody = dataArr
End Function

关键部分说明 #

• 递归逻辑：在ParseEmailBody函数里，我们先处理当前邮件的正文，然后检查是否存在Outlook默认的转发/回复分隔线——找到后就提取分隔线后的内容，递归调用自身解析嵌套的原始邮件，实现深层内容的抓取。
• 数据解析函数：ExtractDataFromBody是你需要根据实际数据格式调整的核心部分——如果你的正文是表格、固定格式的文本，都可以在这里用InStr、Split等函数提取对应字段。
• Outlook对象处理：用GetObject获取已打开的Outlook实例，避免重复启动；只处理Class=43的邮件对象，排除会议邀请、任务提醒等非邮件内容。

注意事项 #

• 如果你用的是HTML格式邮件，也可以改用olMail.HTMLBody，结合MSHTML对象进行更精准的HTML解析，避免纯文本格式的混乱。
• 记得在Excel里启用宏，并且给VBA项目添加对Microsoft Outlook Object Library的引用（如果用早期绑定，可把代码里的Object改成具体的Outlook类型，比如Outlook.Application）。

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