Question

我正在尝试从Outlook的共享收件箱中将特定日期范围的电子邮件拉入Excel。这是代码：

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
object不支持此属性或方法

Answer 1

根据具体的错误，我猜测并非共享收件箱中的Items MailItems都是MailItem - 只有For有ReceivedTime。

我修改了你的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循环：

mean

使用Excel VBA从Outlook访问共享收件箱

1 个答案: