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

问题描述

我正在尝试将 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

标签： excelvbaoutlook

解决方案

遍历文件夹中的所有项目并检查特定项目是否对应于代码中的条件并不是一个好主意！相反，我建议使用类的Find / FindNext或Restrict方法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类的AdvancedSearchApplication方法很有帮助。AdvancedSearch在 Outlook 中使用该方法的主要好处是：

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

有关详细信息和示例代码，请参阅以编程方式在 Outlook 中进行高级搜索：C#、VB.NET。

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

问题描述

解决方案

推荐阅读