如何使用VBA将Outlook中指定日期的HTML表格导入excel

我正在尝试将HTML表格从电子邮件导入excel 我无意中发现了一个代码，它将从选定的文件夹中导入所有html表，不过我想添加一个选项来选择指定的日期

在代码中添加了以下行（如果OutlookMail.ReceivedTime>=Range（“Email\u ReciptDate”）.Value），但是我得到了一个错误

任何帮助都将不胜感激

VBA非常新

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

---

迭代文件夹中的所有项并检查特定项是否与代码中的条件相对应不是一个好主意！相反，我建议使用

Items

类的方法。例如：

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

应用程序

类的方法很有用。在Outlook中使用

AdvancedSearch

方法的主要好处是：

• 搜索在另一个线程中执行。您不需要手动运行另一个线程，因为

  AdvancedSearch

  方法会在后台自动运行它
• 可以在任何位置搜索任何项目类型：邮件、约会、日历、备注等，即超出特定文件夹的范围。

  Restrict

  和

  Find

  /

  FindNext

  方法可应用于特定的

  项目

  集合（请参阅Outlook中

  文件夹

  类的

  项目

  属性）
• 完全支持DASL查询（自定义属性也可用于搜索）。您可以在MSDN中的文章中阅读更多有关这方面的内容。为了提高搜索性能，如果为存储启用了即时搜索，则可以使用即时搜索关键字（请参见

  存储

  类的

  IsInstantSearchEnabled

  属性）
• 您可以使用

  search

  类的

  stop

  方法随时停止搜索过程

---

有关更多信息和示例代码，请参见。

请更清楚地说明您希望实现的修改类型。基本上，我试图实现的是能够将两封电子邮件中的HTML正文合并到一封电子邮件中。然后发送出去。然而，这似乎只是将HTML内部文本提取到excel中。有没有一种方法可以简单地从两封电子邮件中抓取HTML表并将它们合并为1（保留原始表格式）