对象不支持此属性或方法接收时间

Question

我是VB代码的新手，我正在尝试执行下面的代码。但是我收到一条错误消息，此行对象不支持此属性或方法

If VBA.DateValue(VBA.Now) - VBA.DateValue(Folder.Items.Item(iRow).ReceivedTime) <= 60 Then

我认为我的代码没有读取< code>ReceivedTime。我正在使用微软Excel 2010。我如何修理它？

Option Explicit

Sub Download_Outlook_Mail_To_Excel()
    'Add Tools->References->"Microsoft Outlook nn.n Object Library"
    'nn.n varies as per our Outlook Installation
    Dim Folder As Outlook.MAPIFolder
    Dim sFolders 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 = "[e-mail]"

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

    'To directly a Folder at a high level
    Set Folder = Outlook.Session.Folders(MailBoxName).Folders(Pst_Folder_Name)

    'To access a main folder or a subfolder (level-1)
    For Each Folder In Outlook.Session.Folders(MailBoxName).Folders
        If VBA.UCase(Folder.Name) = VBA.UCase(Pst_Folder_Name) Then GoTo Label_Folder_Found
        For Each sFolders In Folder.Folders
            If VBA.UCase(sFolders.Name) = VBA.UCase(Pst_Folder_Name) Then
                Set Folder = sFolders
                GoTo Label_Folder_Found
            End If
        Next sFolders
    Next Folder

Label_Folder_Found:
     If Folder.Name = "" 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) = "Body"

    'Export eMail Data from PST Folder
    oRow = 1
    For iRow = 1 To Folder.Items.Count
        'If condition to import mails received in last 60 days
        'To import all emails, comment or remove this IF condition
        If VBA.DateValue(VBA.Now) - VBA.DateValue(Folder.Items.Item(iRow).ReceivedTime) <= 60 Then

         '  ThisWorkbook.Sheets(1).Cells(oRow, 1).Select
           oRow = oRow + 1
           ThisWorkbook.Sheets(1).Cells(oRow, 1) = Folder.Items.Item(iRow).Body
        End If
    Next iRow
    MsgBox "Outlook Mails Extracted to Excel"
    Set Folder = Nothing
    Set sFolders = Nothing

End_Lbl1:
End Sub

Answer 1

很可能您遇到的是MailItem以外的项，最可能是ReportItem，它不公开ReceivedTime属性。

添加额外的检查，将类属性（由所有Outlook对象公开）设置为43（olMail）。

另一方面，您正在使用多点表示法，这是一个非常糟糕的主意：

   dim vItems as Outlook.Items 
   dim vItem As Object

   set vItems =  Folder.Items
   For iRow = 1 To vItems.Count
           set vItem = vItems.Item(iRow) 
           if vItem.Class = 43 Then
                'If condition to import mails received in last 60 days
                'To import all emails, comment or remove this IF condition
                If VBA.DateValue(VBA.Now) - VBA.DateValue(vItem.ReceivedTime) <= 60 Then
                   oRow = oRow + 1
                   ThisWorkbook.Sheets(1).Cells(oRow, 1) = vItem.Body
                End If
            End If
     Next iRow