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

【问题标题】：Accessing a Shared Inbox from Outlook using Excel VBA使用 Excel VBA 从 Outlook 访问共享收件箱
【发布时间】：2019-03-20 21:51:53
【问题描述】：

我正在尝试将特定日期范围内的电子邮件从 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
对象不支持该属性或方法

【问题讨论】：

具体报错信息是什么？例如，您的收件箱中是否只有电子邮件项目，或者是否还有会议邀请？
您可能需要先测试If TypeOf OutlookMail Is MailItem，然后再检查它的ReceivedTime。
Type Mismatch in mailitem loop的可能重复

标签： vba excel outlook

【解决方案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

【讨论】：

您能帮我解决另一个问题吗？ stackoverflow.com/q/50470916/9824852
我会将您现有的代码复制到新问题中 - 这样每个人都可以按照您的意愿去做。
我正在尝试在下一个空行自动填写我的 excel 表。我是 VBA 新手，所以请原谅我有很多问题。到目前为止，我能够找到下一个空行并将其返回到消息框中。 Sub nextEmptyRow() '查找下一个空行 eRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row '在弹出消息中显示行号 MsgBox eRow End Sub What我想要的不仅是找到下一个空行，而且能够为 GetDataFromOutlook() 运行我的宏并让它从下一个空点开始填充
是的，我读到了你的问题。我假设您在“Email_Subject”、“Email_Date”等范围内有标题。（？）如果是这样，您可以使用Cells(Rows.Count, Range("email_Subject").Column).End(xlUp).Offset(1) 而不是Range("email_Subject").Offset(i, 0)，而不是使用i 来偏移。 /跨度>
附带说明，不要遍历文件夹中的所有项目 - 使用 Items.Restrcit 或 Items.Find/FindNext 搜索“[ReceivedTime] > 'some value'”