当然能搞定这个自动化需求！既然你已经有了提取Outlook邮件完整内容的Macro，我们只需要在现有代码基础上添加文本解析和列匹配的逻辑，就能把邮件里的表格数据精准导入到Excel的对应列中。

核心实现思路 #

邮件里的表格用竖线|作为分隔符，我们可以按以下步骤处理：

• 把提取到的邮件内容按换行符拆分成单独的行
• 过滤掉空行、表头行（避免重复写入）以及无关文本行
• 对每一行数据按|分割，清理掉字段前后的多余空格，再把对应内容写入Excel的指定列

示例代码片段 #

假设你已经通过现有Macro获取到了邮件文本内容（存放在emailBody变量中），下面是处理表格数据的核心代码：

Sub ParseEmailTableToExcel()
    Dim emailBody As String
    Dim targetSheet As Worksheet
    Dim rowArray() As String
    Dim colArray() As String
    Dim rowIndex As Integer, colIndex As Integer
    Dim dataStartRow As Integer
    
    ' 替换成你现有代码中获取邮件内容的逻辑（比如从Outlook邮件Item.Body获取）
    emailBody = "ID | Name | Price | QTY | Valid" & vbCrLf & _
                "1 | ABC | 100.50 | 5 | Y" & vbCrLf & _
                "2 | XYZF | 28.34 | 8 | Y"
    
    ' 创建并命名目标工作表
    Set targetSheet = ThisWorkbook.Sheets.Add
    targetSheet.Name = "每日邮件数据"
    
    ' 写入表头
    targetSheet.Range("A1").Value = "ID"
    targetSheet.Range("B1").Value = "Name"
    targetSheet.Range("C1").Value = "Price"
    targetSheet.Range("D1").Value = "QTY"
    targetSheet.Range("E1").Value = "Valid"
    dataStartRow = 2 ' 从第二行开始写入数据
    
    ' 按换行拆分邮件内容为行数组
    rowArray = Split(emailBody, vbCrLf)
    
    ' 遍历每一行处理数据
    For rowIndex = LBound(rowArray) To UBound(rowArray)
        ' 跳过空行和表头行
        If Trim(rowArray(rowIndex)) <> "" And Not rowArray(rowIndex) Like "*ID | Name*" Then
            ' 按竖线拆分当前行的列内容
            colArray = Split(rowArray(rowIndex), "|")
            
            ' 校验列数，避免格式异常导致报错
            If UBound(colArray) >= 4 Then
                ' 清理空格后写入对应列
                targetSheet.Range("A" & dataStartRow).Value = Trim(colArray(0))
                targetSheet.Range("B" & dataStartRow).Value = Trim(colArray(1))
                targetSheet.Range("C" & dataStartRow).Value = Trim(colArray(2))
                targetSheet.Range("D" & dataStartRow).Value = Trim(colArray(3))
                targetSheet.Range("E" & dataStartRow).Value = Trim(colArray(4))
                dataStartRow = dataStartRow + 1
            End If
        End If
    Next rowIndex
    
    ' 自动调整列宽，提升可读性
    targetSheet.Columns.AutoFit
    MsgBox "数据导入完成！", vbInformation
End Sub

关键细节说明 #

• 文本清理：用Trim()函数去掉每个字段前后的空格，解决邮件表格里|加空格分隔带来的多余空白问题
• 异常防护：添加列数校验UBound(colArray) >=4，防止邮件格式异常的行导致代码崩溃
• 集成现有代码：你只需要把emailBody = ...这部分替换成现有Macro中获取邮件内容的逻辑（比如从Outlook的MailItem.Body属性读取）即可
• 灵活调整：如果邮件里还有其他无关文本，可以先通过查找包含ID | Name的行来定位表格的起始位置，再进行拆分处理

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