将 Outlook 电子邮件提取到 Excel [重复]

Question

我正在尝试将 Outlook 电子邮件导出到 Excel。下面的代码，出于某种未知的原因，只导出了 21 个邮件项。我做错了什么？

数组 olItems 有 1140 个项目。我不明白为什么控件在 21 项之后就跳出循环。

Option Explicit

Sub list_email_info()

Dim xlApp As Excel.Application
Dim xlwb As Excel.Workbook
Dim i As Long
Dim arrHeader As Variant

Dim oINS As NameSpace
Dim oIInboxFolder As MAPIFolder
Dim olItems As Items
Dim olMailItem As MailItem

arrHeader = Array("Date Created", "Subject", "Sender's Name", "Unread")

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlwb = xlApp.Workbooks.Add

Set oINS = GetNamespace("MAPI")
Set oIInboxFolder = oINS.GetDefaultFolder(olFolderInbox).Folders("OST")
Set olItems = oIInboxFolder.Items

i = 1

On Error Resume Next
xlwb.worksheets(1).Range("A1").Resize(1, UBound(arrHeader) + 1).Value = arrHeader

For Each olMailItem In olItems

    xlwb.worksheets(1).cells(i + 1, "A").Value = olItems(i).CreationTime
    xlwb.worksheets(1).cells(i + 1, "B").Value = olItems(i).Subject
    xlwb.worksheets(1).cells(i + 1, "C").Value = olItems(i).SenderName
    xlwb.worksheets(1).cells(i + 1, "D").Value = olItems(i).UnRead

    i = i + 1
Next olMailItem

MsgBox "Done"
xlwb.worksheets(1).cells.entirecolumn.autofit




Set xlwb = Nothing
Set xlApp = Nothing

Set olItems = Nothing
Set oIInboxFolder = Nothing
Set oINS = Nothing


End Sub

@Ben - 我已按照建议进行了修改，但仍然出现类型不匹配错误

@Ben - 当我尝试在编辑器中“运行”代码时出现以下错误。以前没有发生这种情况。

Answer 1

除了MailItems 之外还有其他类型的项目 - 请参阅When is a MailItem not a MailItem。

首先，删除On Error Resume Next。那只是隐藏潜在的错误。

其次，把你的循环改成这样：

Dim itm as Object
For Each itm In olItems
    If TypeOf itm Is MailItem Then
        Set olMailItem = itm
        xlwb.worksheets(1).cells(i + 1, "A").Value = olMailItem.CreationTime
        xlwb.worksheets(1).cells(i + 1, "B").Value = olMailItem.Subject
        xlwb.worksheets(1).cells(i + 1, "C").Value = olMailItem.SenderName
        xlwb.worksheets(1).cells(i + 1, "D").Value = olMailItem.UnRead

        i = i + 1   
    End If  
Next