将Outlook 2010中已发送文件夹中的电子邮件复制到Excel文件

我需要记录我过去几年发送的一些电子邮件，并包括他们被发送给谁，日期和邮件正文 . 从Outlook导出不包含日期，并且由于某种原因Access不会从我公司计算机上的Outlook导入数据

我遇到这个宏从Outlook导出到Excel，我需要的大部分信息，但它从收件箱中拉出来：http://officetricks.com/outlook-email-download-to-excel/

我在Office VBA网站上搜索了命令，使其从“已发送邮件”文件夹而不是“收件箱”导出，但是我在ReceivedByDate和CC行（在下面的For命令下）一直得到运行时错误438 "Object doesn't support this property or method" . 它只发生在我发送的电子邮件中 . 我尝试将它们移动到一个单独的文件夹并进入我的收件箱，但宏在读取我发送的电子邮件时失败 .

Sub Mail_to_Excel()
'
' Mail_to_Excel Macro
' Copies emails from Outlook to an Excel file
' Add Tools->References->"Microsoft Outlook nn.n Object Library"
' nn.n varies as per our Outlook Installation
    Dim Folder As Outlook.MAPIFolder
    Dim iRow As Integer, oRow As Integer
    Dim MailBoxName As String, Pst_Folder_Name  As String

    'Mailbox or PST Main Folder Name (As how it is displayed in your Outlook Session)
    MailBoxName = "MyName@Company.com"

    'Mailbox Folder or PST Folder Name (As how it is displayed in your Outlook Session)
    Pst_Folder_Name = "Sent Items"

    Set Folder = Outlook.Session.Folders(MailBoxName).Folders(Pst_Folder_Name)
    If Folder = "" Then
        MsgBox "Invalid Data in Input"
        GoTo end_lbl1:
    End If

    'Read Through each Mail and export the details to Excel for Email Archival
    ThisWorkbook.Sheets(1).Activate
    Folder.Items.Sort "Received"

    'Insert Column Headers
    ThisWorkbook.Sheets(1).Cells(1, 1) = "Sent to"
    ThisWorkbook.Sheets(1).Cells(1, 2) = "Copied"
    ThisWorkbook.Sheets(1).Cells(1, 3) = "Subject"
    ThisWorkbook.Sheets(1).Cells(1, 4) = "Date"
    ThisWorkbook.Sheets(1).Cells(1, 5) = "Size"
    ThisWorkbook.Sheets(1).Cells(1, 6) = "Body"

    'Insert Mail Data
    For iRow = 1 To 5
    'Folder.Items.Count
        oRow = iRow + 1
        ThisWorkbook.Sheets(1).Cells(oRow, 1).Select
        ThisWorkbook.Sheets(1).Cells(oRow, 1) = Folder.Items.Item(iRow).ReceivedByName
        ThisWorkbook.Sheets(1).Cells(oRow, 2) = Folder.Items.Item(iRow).CC
        ThisWorkbook.Sheets(1).Cells(oRow, 3) = Folder.Items.Item(iRow).Subject
        ThisWorkbook.Sheets(1).Cells(oRow, 4) = Folder.Items.Item(iRow).ReceivedTime
        ThisWorkbook.Sheets(1).Cells(oRow, 5) = Folder.Items.Item(iRow).Size
        ThisWorkbook.Sheets(1).Cells(iRow, 6) = Folder.Items.Item(iRow).Body
    Next iRow

    MsgBox "Outlook Mails Extracted to Excel"

end_lbl1:
End Sub