Excel 如何导入Outlook报表项数据？

我正在尝试使用VBA导入Outlook电子邮件数据，并成功导入以下代码：

Sub getMail()
   
    Dim i As Long
    Dim arrHeader As Variant
    
    Dim olNS As Namespace
    Dim olInboxFolder As MAPIFolder
    Dim olItems As items
    Dim olMailItem As MailItem
    Dim objRept As ReportItem
    
    arrHeader = Array("Date Created", "SenderEmailAddress", "Subject", "Body")
    
    Set olNS = GetNamespace("MAPI")
    Set olInboxFolder = olNS.PickFolder
    Set olItems = olInboxFolder.items
    Set olReportItem = olInboxFolder.items
    
    Dim items, objects As Variant
    items = Array(olMailItem, olReportItem)
    objects = Array(MailItem, ReportItem)
    
    i = 1
    
    ThisWorkbook.Worksheets(2).Range("A1").Resize(1, UBound(arrHeader) + 1).Value = arrHeader
    
    For Each olMailItem In olItems
      
        ThisWorkbook.Worksheets(2).Cells(i + 1, "A").Value = olItems(i).CreationTime
        ThisWorkbook.Worksheets(2).Cells(i + 1, "B").Value = olItems(i).SenderEmailAddress
        ThisWorkbook.Worksheets(2).Cells(i + 1, "C").Value = olItems(i).Subject
        ThisWorkbook.Worksheets(2).Cells(i + 1, "D").Value = olItems(i).Body
        
        i = i + 1
        
    Next olMailItem
    
    ThisWorkbook.Worksheets(2).Cells.EntireColumn.AutoFit
    
    MsgBox "Export complete.", vbInformation
    
    Set olItems = Nothing
    Set olInboxFolder = Nothing
    Set olNS = Nothing

End Sub

---

此代码仅导入邮件项目。未送达的电子邮件称为reportitems，我无法使其正常工作。

您的循环正在使用您声明为MailItem的olMailItem。此外，您将无法在报表项上使用“.SenderEmailAddress”

请尝试以下操作：

Sub getMail()
    Dim i As Long
    Dim arrHeader As Variant
    
    Dim olNS As Namespace
    Dim olInboxFolder As MAPIFolder
    Dim olItems As items
    Dim olItem As Variant
    
    Set olNS = GetNamespace("MAPI")
    Set olInboxFolder = olNS.PickFolder
    Set olItems = olInboxFolder.items
    
    arrHeader = Array("Date Created", "SenderEmailAddress", "Subject", "Body")
    ThisWorkbook.Worksheets(2).Range("A1").Resize(1, UBound(arrHeader) + 1).Value = arrHeader

    i = 1
    
    For Each olItem In olItems
        ' MailItem
        If olItem.Class = olMail Then
            ThisWorkbook.Worksheets(2).Cells(i + 1, "A").Value = olItems(i).CreationTime
            ThisWorkbook.Worksheets(2).Cells(i + 1, "B").Value = olItems(i).SenderEmailAddress
            ThisWorkbook.Worksheets(2).Cells(i + 1, "C").Value = olItems(i).Subject
            ThisWorkbook.Worksheets(2).Cells(i + 1, "D").Value = olItems(i).Body
        ' ReportItem
        ElseIf olItem.Class = olReport Then
            ThisWorkbook.Worksheets(2).Cells(i + 1, "A").Value = olItems(i).CreationTime
            ThisWorkbook.Worksheets(2).Cells(i + 1, "B").Value = _
                olItems(i).PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0C1F001E") ' PR_SENDER_EMAIL_ADDRESS
            ThisWorkbook.Worksheets(2).Cells(i + 1, "C").Value = olItems(i).Subject
        End If
        
        i = i + 1
    Next olItem
    
    ThisWorkbook.Worksheets(2).Cells.EntireColumn.AutoFit
    
    MsgBox "Export complete.", vbInformation
           
    Set olItems = Nothing
    Set olInboxFolder = Nothing
    Set olNS = Nothing
End Sub

---

它对我有用。“传递状态通知（失败）”未送达的电子邮件也会收到exported@SiddharthRout当我发现无法投递的东西是家里的邮件时，我很惊讶。