如何使用 VBA 将指定日期的 Outlook 中的 HTML 表格导入 Excel？答案

【问题标题】：How to import HTML Table from Outlook for a specified Date into Excel using VBA?如何使用 VBA 将指定日期的 Outlook 中的 HTML 表格导入 Excel？
【发布时间】：2021-04-06 10:35:23
【问题描述】：

我正在尝试将 HTML 表格从电子邮件导入 Excel。

我在这里偶然发现了可以从选定文件夹导入所有 html 表的代码。我想添加一个选项来选择指定的日期。

已添加以下行

If OutlookMail.ReceivedTime >= Range("Email_ReciptDate").Value Then)

我收到一个错误。

Dim oApp As Outlook.Application
Dim oMapi As Outlook.MAPIFolder
Dim oMail As Outlook.MailItem
Dim HTMLdoc As MSHTML.HTMLDocument
Dim tables As MSHTML.IHTMLElementCollection
Dim table As MSHTML.HTMLTable
Dim x As Long, y As Long
Dim destCell As Range

With ActiveSheet
    Set destCell = .Cells(Rows.Count, "A").End(xlUp)
End With
   
On Error Resume Next
Set oApp = GetObject(, "OUTLOOK.APPLICATION")
If oApp Is Nothing Then Set oApp = CreateObject("OUTLOOK.APPLICATION")
On Error GoTo 0

Set oMapi = oApp.GetNamespace("MAPI").PickFolder

If Not oMapi Is Nothing Then

    For Each oMail In oMapi.Items
    
        If OutlookMail.ReceivedTime >= Range("Email_ReciptDate").Value Then
        
            'Get HTML tables from email object
        
            Set HTMLdoc = New MSHTML.HTMLDocument
            With HTMLdoc
                .Body.innerHTML = oMail.HTMLBody
                Set tables = .getElementsByTagName("table")
            End With
    
            'Import each table into Excel
        
            For Each table In tables
                For x = 0 To table.Rows.Length - 1
                    For y = 0 To table.Rows(x).Cells.Length - 1
                        destCell.Offset(x, y).Value = table.Rows(x).Cells(y).innerText
                    Next y
                Next x
                Set destCell = destCell.Offset(x)
            Next
        End If
    Next
        
    MsgBox "Finished"
    
End If

Set oApp = Nothing
Set oMapi = Nothing
Set oMail = Nothing
Set HTMLdoc = Nothing
Set tables = Nothing

【问题讨论】：

请更清楚一点，您想要实现什么样的修改。
基本上我想要实现的是能够将 2 封电子邮件的 HTML 正文合并到一封电子邮件中。然后发送出去。但是，这似乎只是将 HTML 内部文本提取到 excel 中。有没有办法我可以简单地从两封电子邮件中获取 HTML 表格并将它们组合成 1（保留原始表格格式）

标签： excel vba outlook

【解决方案1】：

遍历文件夹中的所有项目并检查特定项目是否符合代码中的条件并不是一个好主意！相反，我建议使用Items 类的Find/FindNext 或Restrict 方法。例如：

Public Sub ContactDateCheck()  
    Dim myNamespace As Outlook.NameSpace  
    Dim myContacts As Outlook.Items  
    Dim myItems As Outlook.Items  
    Dim myItem As Object  
      
    Set myNamespace = Application.GetNamespace("MAPI")  
    Set myContacts = myNamespace.GetDefaultFolder(olFolderContacts).Items  
    Set myItems = myContacts.Restrict("[LastModificationTime] > '01/1/2021'")  
    For Each myItem In myItems  
        If (myItem.Class = olContact) Then  
            MsgBox myItem.FullName & ": " & myItem.LastModificationTime  
        End If  
    Next  
End Sub

在以下文章中详细了解这些方法：

您还可能会发现 Outlook Application 类的 AdvancedSearch 方法很有帮助。在 Outlook 中使用 AdvancedSearch 方法的主要好处是：

搜索在另一个线程中执行。您无需手动运行另一个线程，因为 AdvancedSearch 方法会在后台自动运行它。
可以在任何位置（即超出某个文件夹的范围）搜索任何项目类型：邮件、约会、日历、便笺等。 Restrict 和 Find/FindNext 方法可以应用于特定的 Items 集合（请参阅 Outlook 中 Folder 类的 Items 属性）。
完全支持 DASL 查询（自定义属性也可用于搜索）。您可以在 MSDN 中的 Filtering 文章中阅读更多相关信息。为了提高搜索性能，如果为商店启用了即时搜索，则可以使用即时搜索关键字（请参阅Store 类的IsInstantSearchEnabled 属性）。
您可以随时使用Search 类的Stop 方法停止搜索过程。

有关更多信息和示例代码，请参阅Advanced search in Outlook programmatically: C#, VB.NET。

【讨论】：