无法从Outlook下载所有电子邮件,同时在Outlook下方获取“单击此处以查看有关Microsoft Exchange的更多信息”

时间:2019-11-19 16:29:05

标签: excel vba outlook

我想从Outlook收件箱中获取所有电子邮件。 仅允许该程序获取“单击此处以在Microsoft Exchange上查看更多信息”链接之前的电子邮件。 而且我无权更改Outlook设置。下面是代码。

Set applOutlook = CreateObject("Outlook.Application")
Set nsOutlook = applOutlook.GetNamespace("MAPI")
Set mFolder = nsOutlook.GetDefaultFolder(olFolderInbox)

'set the items collection:
Set mItems = mFolder.Items

i = 1

count = mItems.count

If count > 0 Then

With wReports.Worksheets(1)

    Do While i <= count

        Set mItem = mItems.Item(i)
        .Range("A" & i + 1) = mItem.SenderName
        .Range("B" & i + 1) = mItem.Subject
        .Range("C" & i + 1) = mItem.Categories
        .Range("D" & i + 1) = mItem.ReceivedTime

        i = i + 1

    Loop

end with

0 个答案:

没有答案