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

时间:2015-05-14 02:17:17

标签: excel vba excel-vba outlook-vba

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

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

我在Office VBA网站上搜索了命令,使其从“已发送邮件”文件夹而不是“收件箱”中导出,但我一直收到运行时错误438"对象不支持此属性或者方法" 在ReceivedByDate和CC行(在下面的For命令下)。它只发生在我发送的电子邮件中。我尝试将它们移动到一个单独的文件夹并进入我的收件箱,但宏在读取我发送的电子邮件时失败。

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

1 个答案:

答案 0 :(得分:0)

尝试SentOn https://msdn.microsoft.com/en-us/library/office/ff864408.aspx而不是ReceivedTime。

您可能对两者之间的差异感兴趣。 MAPI Outlook object model Mailitem.senton > Mailitem.receivedtime, how is this possible?

“已发送邮件”文件夹中的某些项目不是邮件项目,因此可能没有.CC属性。

您需要进行类似

的测试
If Item(iRow).class = olMail then