使用日期标准或主题标准将 Outlook 电子邮件数据导入 Excel答案

【问题标题】：Import Outlook email data to Excel using Date Criteria or Subject Criteria使用日期标准或主题标准将 Outlook 电子邮件数据导入 Excel
【发布时间】：2018-04-29 04:19:21
【问题描述】：

我正在尝试从 Outlook 导入邮件数据。我正在使用下面的代码。此代码显示“类型不匹配”错误。但有些邮件会复制到 Excel 工作表中。

如何导入具有特定主题行的邮件或在特定日期收到的邮件。

Sub GetFromInbox()
    Dim olapp As Outlook.Application
    Dim olNs As Outlook.Namespace
    Dim Fldr As Outlook.MAPIFolder
    Dim olMail As Outlook.MailItem
    Dim Pst_Folder_Name As String, MailboxName As String
    Dim i As Long

    MailboxName = "xxxx@yyyyy.com"
    Pst_Folder_Name = "Inbox"
    Set olapp = New Outlook.Application
    Set olNs = olapp.GetNamespace("MAPI")

    Set Fldr = olNs.Folders(MailboxName).Folders(Pst_Folder_Name)

    With Sheets("sheet1")
        .Cells.ClearContents
        .Cells(1, 1).Value = "Date"
        i = 2
        For Each olMail In Fldr.Items
            'For Each olMail In olapp.CurrentFolder.Items
            .Cells(i, 1).Value = olMail.ReceivedTime
            .Cells(i, 3).Value = olMail.Subject
            .Cells(i, 4).Value = olMail.SenderName
            .Cells(i, 5).Value = olMail.Body
            i = i + 1
        Next olMail
    End With

    olapp.Quit
    Set olapp = Nothing
End Sub

【问题讨论】：

代码对我来说运行良好。不说你在哪里得到类型不匹配错误，很难提供帮助。而且您还要求提供更多代码 （我们有没有办法可以导出仅具有特定主题行的邮件或在特定日期收到的邮件。）自己的。因此，我不明白为什么会对此表示赞成。

标签： excel vba outlook outlook-filter

【解决方案1】：

使用Items.Restrict Method (Outlook) 按主题行或日期过滤

主题示例

Dim Filter As String
    Filter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & _
                       Chr(34) & " Like '%Bla Bla%'"
_{对 Items 集合应用过滤器，返回一个新集合，其中包含原始集合中与过滤器匹配的所有项目。}

_{此方法是使用 Find method 或 FindNext method 迭代集合中特定项目的替代方法。如果项目数量较少，Find 或 FindNext methods 比过滤更快。如果集合中有大量项目，则 Restrict 方法的速度会明显加快，尤其是在预计只能找到大型集合中的少数项目的情况下。}

 "Type MisMatch" error

Outlook 收件箱/文件夹有不同类型的对象MailItem, AppointmentItem, ContactItem, etc所以error 可能是你点击了一个不是 MailItem 的项目。

试试

If TypeOf olMail Is Outlook.MailItem Then

所以你的代码应该是这样的

Option Explicit
Sub GetFromInbox()
    Dim olapp As Outlook.Application
    Dim olNs As Outlook.Namespace
    Dim Fldr As Outlook.MAPIFolder
    Dim olMail As Object
    Dim Pst_Folder_Name As String, MailboxName As String
    Dim i As Long

    MailboxName = "xxxx@yyyyy.com"

    Pst_Folder_Name = "Inbox"

    Set olapp = New Outlook.Application
    Set olNs = olapp.GetNamespace("MAPI")
    Set Fldr = olNs.Folders(MailboxName).Folders(Pst_Folder_Name)

    Dim Filter As String
        Filter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & _
                           Chr(34) & " Like '%bla bla %'"

    With Sheets("sheet1")
        .Cells.ClearContents
        .Cells(1, 1).Value = "Date"

         i = 2

        For Each olMail In Fldr.Items.Restrict(Filter)
            If TypeOf olMail Is Outlook.MailItem Then
                DoEvents
                .Cells(i, 1).Value = olMail.ReceivedTime
                .Cells(i, 3).Value = olMail.Subject
                .Cells(i, 4).Value = olMail.SenderName
                .Cells(i, 5).Value = olMail.Body
            End If
            i = i + 1
        Next olMail
    End With

    olapp.Quit
    Set olapp = Nothing
End Sub

【讨论】：