Доступ к общему почтовому ящику из Outlook с помощью Excel VBA

Question

Я пытаюсь перетащить электронные письма для определенного диапазона дат в Excel из общей папки входящих сообщений в Outlook.Вот код:

Sub getDataFromOutlook()

Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Namespace
Dim Folder As MAPIFolder
Dim OutlookMail As Variant
Dim objOwner As Outlook.Recipient
Dim i As Integer

Set OutlookApp = New Outlook.Application
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
Set objOwner = OutlookNamespace.CreateRecipient("xxxxxx@xxxxxx.com")
objOwner.Resolve

If objOwner.Resolved Then
    Set Folder = OutlookNamespace.GetSharedDefaultFolder(objOwner, olFolderInbox)
End If

i = 1

For Each OutlookMail In Folder.Items

    If OutlookMail.ReceivedTime >= Range("email_ReceiptDate").Value Then

        Range("email_Subject").Offset(i, 0) = OutlookMail.Subject
        Range("email_Subject").Offset(i, 0).Columns.AutoFit
        Range("email_Subject").Offset(i, 0).VerticalAlignment = xlTop
        Range("email_Date").Offset(i, 0) = OutlookMail.ReceivedTime
        Range("email_Date").Offset(i, 0).Columns.AutoFit
        Range("email_Date").Offset(i, 0).VerticalAlignment = xlTop
        Range("email_Sender").Offset(i, 0) = OutlookMail.SenderName
        Range("email_Sender").Offset(i, 0).Columns.AutoFit
        Range("email_Sender").Offset(i, 0).VerticalAlignment = xlTop
        Range("email_Body").Offset(i, 0) = OutlookMail.Body
        Range("email_Body").Offset(i, 0).Columns.AutoFit
        Range("email_Body").Offset(i, 0).VerticalAlignment = xlTop

        i = i + 1

    End If

Next OutlookMail

Set Folder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing

End Sub

В соответствии с отладчиком ошибка в

 If OutlookMail.ReceivedTime >= Range("email_ReceiptDate").Value Then

Я выполнил эту часть кода в тесте на моем почтовом ящике, и он работал.

Добавлен

objOwner.Resolve

If objOwner.Resolved Then
    Set Folder = OutlookNamespace.GetSharedDefaultFolder(objOwner, olFolderInbox)
End If

По-прежнему появляется ошибка:

Ошибка времени выполнения 438
Объект не поддерживает это свойство или метод

Answer 1

Исходя из конкретной ошибки, я предполагаю, что не все Items в вашей общей папке входящих сообщений MailItems - только MailItem имеет ReceivedTime.

Я бы пересмотрел ваш For цикл:

For Each OutlookMail In Folder.Items

    If TypeOf OutlookMail Is MailItem Then
       If OutlookMail.ReceivedTime >= Range("email_ReceiptDate").Value Then
           ' rest of your code
       End If
    End If

Next OutlookMail