收件箱中 Outlook 对象的 ReceivedTime 生成错误“对象不支持此属性或方法”

Posted 2023-03-27

【中文标题】收件箱中 Outlook 对象的 ReceivedTime 生成错误“对象不支持此属性或方法”

【英文标题】：ReceivedTime of Outlook object in Inbox generates error "Object doesn't support this property or method"

【发布时间】：2022-01-23 20:17:01

【问题描述】：

我每天早上都在运行 Windows 任务计划程序任务来运行 Excel 文件中的宏。我的任务不起作用，因为 VBA 代码现在给了我一个错误。在今天之前，VBA 代码 100% 正常运行。

我明白了

“对象不支持此属性或方法”

Dim olApp As Object
Dim olNS As Object
Dim myDate As Date
Dim olItems As Object
Dim olItem As Object
Dim olAttach As Object
Dim Date1 As String
Dim Date2 As String
Dim iAttachments As Integer

Date1 = Date & " " & TimeValue("6:00:00")
Date2 = Date & " " & TimeValue("00:00:00")

On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
Err.Clear: On Error GoTo 0

If olApp Is Nothing Then
Set olApp = CreateObject("Outlook.Application")
End If

Set olNS = olApp.GetNamespace("MAPI")

Set olItems = olNS.GetDefaultFolder(olFolderInbox).Items

For Each olItem In olItems

    If olItem.ReceivedTime < Date1 Then  '<----- ERROR LINE
        If olItem.ReceivedTime > Date2 Then
            If InStr(olItem.Body, "Darth Vader") > 0 Then

                iAttachments = olItem.Attachments.Count + iAttachments

                Set olAttach = olItem.Attachments.Item(1)

                On Error GoTo Err_Handler
                olAttach.SaveAsFile "C:\Desktop\Automatic Outlook Downloads" & "\" & olAttach.Filename

                Set olAttach = Nothing
                Set olItem = Nothing

                If iAttachments = 4 Then Exit For
            End If
        End If
    End If
Next

    Set olAttach = Nothing
    Set olItem = Nothing
    Set olApp = Nothing
    Set olNS = Nothing
    Set olItems = Nothing

Exit Sub

【问题讨论】：

这一定意味着您收件箱中的某些项目没有ReceivedTime 属性。你关心的是哪个type of items？大概是MailItems（都会有这个属性）。还有其他你关心的类型吗？

我只是想从我的收件箱中提取 4 个附件，这些附件是每天凌晨 12:00 到 6:00 之间通过电子邮件收到的。所以不，我不关心其他类型。

您需要确保olItem 是MailItem。只需在尝试访问其成员之前验证 TypeName(olItem) = "MailItem" 应该没问题。

那是说你要更一致地indent你的代码。

【参考方案1】：

Some Items in the Inbox may not be MailItems 否则可能没有ReceivedTime 属性。由于您只关心MailItem 类型，您应该能够在您的For Each 中使用以下条件检查：

For Each olItem In olItems
    'With early binding, you could use:
    ' If TypeOf olItem Is MailItem Then 
    'Otherwise:
    If TypeName(olItem) = "MailItem" Then
        If olItem.ReceivedTime < Date1 Then  ' <----- ERROR LINE
        If olItem.ReceivedTime > Date2 Then
        If InStr(olItem.Body, "Darth Vader") > 0 Then

        iAttachments = olItem.Attachments.Count + iAttachments

        Set olAttach = olItem.Attachments.Item(1)

        On Error GoTo Err_Handler
        olAttach.SaveAsFile "C:\Desktop\Automatic Outlook Downloads" & "\" & olAttach.Filename

        Set olAttach = Nothing
        Set olItem = Nothing


        If iAttachments = 4 Then Exit For
        End If
        End If
    End If
Next

【参考方案2】：

所以我能够解决我自己的问题。我不确定为什么我的代码在今天之前可以 100% 工作，但我确实进行了调整，以便我可以在 Excel 日期和 Outlook 日期之间拥有更兼容的语法。下面是我修改后的代码，它更改了我的 Excel 日期格式以匹配 Outlook 日期格式。此外，我决定将我的 olItems 限制在我的时间范围内，而不是“IF”条件，然后循环我的条件。

Dim olApp As Object
Dim olNS As Object
Dim myDate As Date
Dim olItems As Object
Dim olItem As Object
Dim olAttach As Object
Dim Date1 As String
Dim Date2 As String
Dim iAttachments As Integer

Date1 = Date & " " & TimeValue("6:00:00 am")
Date11 = Format(Date1, "ddddd h:nn AMPM")     <----- Date to match Outlook format
Date2 = Date & " " & TimeValue("00:00:00 am")
Date22 = Format(Date2, "ddddd h:nn AMPM")     <----- Date to match Outlook format


On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
Err.Clear: On Error GoTo 0

If olApp Is Nothing Then
Set olApp = CreateObject("Outlook.Application")
End If

Set olNS = olApp.GetNamespace("MAPI")



Set olItems = olNS.GetDefaultFolder(olFolderInbox).Items.Restrict("[ReceivedTime] > """ & Date22 & """ and [ReceivedTime] < """ & Date11 & """")     <----- Restricted my olItems to my specific range



For Each olItem In olItems
    If InStr(olItem.Body, "Darth Vader") > 0 Then

    iAttachments = olItem.Attachments.Count + iAttachments

    Set olAttach = olItem.Attachments.Item(1)

    On Error GoTo Err_Handler
    olAttach.SaveAsFile "C:\Desktop\Automatic Outlook Downloads" & "\" & olAttach.Filename

    Set olAttach = Nothing
    Set olItem = Nothing


    If iAttachments = 4 Then Exit For

    End If
Next


    Set olAttach = Nothing
    Set olItem = Nothing
    Set olApp = Nothing
    Set olNS = Nothing
    Set olItems = Nothing



Exit Sub