VB.NET提取Outlook邮件Excel表格并清空内容保留格式方案咨询

方法1：通过Outlook Word编辑器提取表格（规避HTML解析问题） #

Outlook邮件正文本质是Word文档，直接用Word对象模型操作更稳定，无需处理HTML兼容性问题：

• 用MailItem.GetInspector.WordEditor获取邮件的Word文档实例
• 遍历文档中的Tables集合，复制表格结构
• 清空所有单元格内容，保留格式
• 将处理后的表格转为HTML字符串存入List(Of String)

代码示例：

Function GetEmptyTablesFromOutlook(Subject As String, daysAgo As Integer) As List(Of String)
    Dim emptyTables As New List(Of String)
    Dim olApp As New Outlook.Application
    Dim ns As Outlook.NameSpace = olApp.GetNamespace("MAPI")
    Dim inbox As Outlook.MAPIFolder = ns.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
    
    ' 时间过滤（替换为你的业务日期逻辑）
    Dim filterDate As Date = Date.Now.AddDays(-daysAgo)
    Dim filter As String = $"@SQL=""urn:schemas:httpmail:subject"" LIKE '%{Subject}%' AND ""urn:schemas:httpmail:datereceived"" >= '{filterDate:yyyy-MM-dd HH:mm:ss}'"
    Dim filteredItems As Outlook.Items = inbox.Items.Restrict(filter)
    filteredItems.Sort("[ReceivedTime]", Outlook.OlSortOrder.olDescending)
    
    For Each item As Object In filteredItems
        If TypeOf item Is Outlook.MailItem Then
            Dim mail As Outlook.MailItem = CType(item, Outlook.MailItem)
            Dim wordDoc As Word.Document = mail.GetInspector.WordEditor
            
            For Each table As Word.Table In wordDoc.Tables
                ' 复制表格到临时文档（避免修改原邮件）
                Dim tempDoc As New Word.Document
                table.Range.Copy()
                tempDoc.Range.Paste()
                Dim tempTable As Word.Table = tempDoc.Tables(1)
                
                ' 清空单元格内容，保留格式
                For Each cell As Word.Cell In tempTable.Range.Cells
                    cell.Range.Text = ""
                Next
                
                ' 将空表格转为HTML字符串
                Dim tempPath As String = Path.Combine(Path.GetTempPath(), "temp_table.html")
                tempDoc.SaveAs2(tempPath, Word.WdSaveFormat.wdFormatFilteredHTML)
                tempDoc.Close(False)
                emptyTables.Add(File.ReadAllText(tempPath))
                File.Delete(tempPath)
            Next
            wordDoc = Nothing
        End If
    Next
    
    Return emptyTables
End Function

注意：需添加Word Interop引用（Microsoft.Office.Interop.Word）

方法2：用HtmlAgilityPack修复HTML解析问题 #

原方法使用mshtml可能无法正确解析Outlook生成的HTML，改用HtmlAgilityPack（轻量HTML解析库）处理更可靠：

• 安装HtmlAgilityPack NuGet包
• 解析邮件的HTMLBody，提取所有<table>节点
• 遍历每个<td>/<th>节点，清空其内部文本和子节点（保留标签结构）
• 将处理后的表格HTML字符串存入List(Of String)

代码示例：

Imports HtmlAgilityPack

Function GetEmptyTablesViaHtmlAgility(Subject As String, daysAgo As Integer) As List(Of String)
    Dim emptyTables As New List(Of String)
    Dim olApp As New Outlook.Application
    Dim ns As Outlook.NameSpace = olApp.GetNamespace("MAPI")
    Dim inbox As Outlook.MAPIFolder = ns.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
    
    ' 过滤逻辑同方法1
    Dim filterDate As Date = Date.Now.AddDays(-daysAgo)
    Dim filter As String = $"@SQL=""urn:schemas:httpmail:subject"" LIKE '%{Subject}%' AND ""urn:schemas:httpmail:datereceived"" >= '{filterDate:yyyy-MM-dd HH:mm:ss}'"
    Dim filteredItems As Outlook.Items = inbox.Items.Restrict(filter)
    
    For Each item As Object In filteredItems
        If TypeOf item Is Outlook.MailItem Then
            Dim mail As Outlook.MailItem = CType(item, Outlook.MailItem)
            Dim htmlDoc As New HtmlDocument()
            htmlDoc.LoadHtml(mail.HTMLBody)
            
            ' 提取所有表格节点
            Dim tables As HtmlNodeCollection = htmlDoc.DocumentNode.SelectNodes("//table")
            If tables IsNot Nothing Then
                For Each table As HtmlNode In tables
                    ' 清空所有单元格内容
                    Dim cells As HtmlNodeCollection = table.SelectNodes(".//td|.//th")
                    If cells IsNot Nothing Then
                        For Each cell As HtmlNode In cells
                            cell.RemoveAllChildren() ' 保留单元格标签，清空内部内容
                        Next
                    End If
                    ' 将处理后的表格转为字符串加入列表
                    emptyTables.Add(table.OuterHtml)
                Next
            End If
        End If
    Next
    
    Return emptyTables
End Function

方法3：通过Excel Interop复制表格布局 #

如果邮件中的表格是嵌入的Excel对象而非HTML表格，可直接操作Excel对象：

• 提取邮件中的Excel嵌入对象
• 复制表格结构到新工作表，清空单元格值
• 将空表格导出为HTML或XML格式存入列表

代码示例（处理嵌入Excel对象）：

Function GetEmptyExcelTablesFromMail(Subject As String, daysAgo As Integer) As List(Of String)
    Dim emptyTables As New List(Of String)
    Dim olApp As New Outlook.Application
    Dim ns As Outlook.NameSpace = olApp.GetNamespace("MAPI")
    Dim inbox As Outlook.MAPIFolder = ns.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
    
    Dim filterDate As Date = Date.Now.AddDays(-daysAgo)
    Dim filter As String = $"@SQL=""urn:schemas:httpmail:subject"" LIKE '%{Subject}%' AND ""urn:schemas:httpmail:datereceived"" >= '{filterDate:yyyy-MM-dd HH:mm:ss}'"
    Dim filteredItems As Outlook.Items = inbox.Items.Restrict(filter)
    
    For Each item As Object In filteredItems
        If TypeOf item Is Outlook.MailItem Then
            Dim mail As Outlook.MailItem = CType(item, Outlook.MailItem)
            For Each att As Outlook.Attachment In mail.Attachments
                If att.Type = Outlook.OlAttachmentType.olEmbeddeditem AndAlso att.FileName.EndsWith(".xlsx", StringComparison.OrdinalIgnoreCase) Then
                    ' 保存嵌入的Excel文件到临时路径
                    Dim tempPath As String = Path.Combine(Path.GetTempPath(), att.FileName)
                    att.SaveAsFile(tempPath)
                    
                    ' 打开Excel文件
                    Dim excelApp As New Excel.Application
                    Dim workbook As Excel.Workbook = excelApp.Workbooks.Open(tempPath)
                    Dim worksheet As Excel.Worksheet = CType(workbook.Sheets(1), Excel.Worksheet)
                    
                    ' 复制表格区域（假设是UsedRange）
                    Dim tableRange As Excel.Range = worksheet.UsedRange
                    Dim newWorkbook As Excel.Workbook = excelApp.Workbooks.Add()
                    Dim newWorksheet As Excel.Worksheet = CType(newWorkbook.Sheets(1), Excel.Worksheet)
                    tableRange.Copy(newWorksheet.Range("A1"))
                    
                    ' 清空单元格内容，保留格式
                    newWorksheet.UsedRange.ClearContents()
                    
                    ' 导出为HTML片段
                    Dim htmlPath As String = Path.Combine(Path.GetTempPath(), "empty_table.html")
                    newWorkbook.SaveAs(htmlPath, Excel.XlFileFormat.xlHtml)
                    emptyTables.Add(File.ReadAllText(htmlPath))
                    
                    ' 清理资源
                    newWorkbook.Close(False)
                    workbook.Close(False)
                    excelApp.Quit()
                    File.Delete(tempPath)
                    File.Delete(htmlPath)
                End If
            Next
        End If
    Next
    
    Return emptyTables
End Function

注意：需添加Excel Interop引用（Microsoft.Office.Interop.Excel）

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