Question

我正在尝试从Outlook导入邮件数据。我正在使用下面的代码。此代码显示“Type MisMatch”错误。但有些邮件会复制到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

Answer 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

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

1 个答案: