Импортируйте данные электронной почты Outlook в Excel, используя критерии даты или темы - PullRequest
Новая
       13

Импортируйте данные электронной почты Outlook в Excel, используя критерии даты или темы

0 голосов
/ 29 апреля 2018

Я пытаюсь импортировать данные почты из 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

1 Ответ

0 голосов
/ 29 апреля 2018

Использование Items.Restrict Method (Outlook) для фильтрации по строке темы или дате

Пример темы 

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

Применяет фильтр к коллекции элементов, возвращая новую коллекцию, содержащую все элементы из оригинала, соответствующие фильтру.

Этот метод является альтернативой использованию метода поиска или метода FindNext для итерации по конкретному предметы в коллекции. Методы Find или FindNext работают быстрее, чем фильтрация, если имеется небольшое количество элементов. Метод 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
...