VBA下载指定日期后Outlook邮件附件时出现438错误求助

错误438的根源是：OlFolder.Items集合包含的不只是邮件（MailItem），还可能有会议邀请、系统报告等其他类型的Outlook项目，这些对象没有ReceivedTime属性，当循环到这类项目时就会触发"对象不支持该属性或方法"的错误。

下面提供两种可行的解决方案，第二种更高效简洁：

方案1：循环时判断项目类型 #

在遍历OlItems时，先检查当前项目是否为邮件类型（Class=43，对应常量olMailItem），仅处理邮件对象：

Option Explicit

Private Sub btn_extractemails_Click()

Dim OlApp As Object
Dim OlMail As Object
Dim OlItems As Object
Dim OlFolder As Object
Dim j As Integer
Dim strFolder As String
Dim rec_date As Date

Set OlApp = GetObject(, "Outlook.Application")
If Err.Number = 429 Then
    Set OlApp = CreateObject("Outlook.Application")
End If

strFolder = ThisWorkbook.Path & "\Extract_test"
rec_date = #8/17/2022#

Set OlFolder = OlApp.GetNamespace("MAPI").Folders("Folder1").Folders("Folder2").Folders("Folder3")

Set OlItems = OlFolder.Items
OlItems.Sort "[ReceivedTime]"

For Each OlMail In OlItems
    ' 仅处理邮件类型项目
    If OlMail.Class = 43 Then
        If OlMail.ReceivedTime >= rec_date Then
            If OlMail.Attachments.Count > 0 Then
                For j = 1 To OlMail.Attachments.Count
                    OlMail.Attachments.Item(j).SaveAsFile strFolder & "\" & OlMail.Attachments.Item(j).Filename
                Next j
            End If
        End If
    End If
Next

Set OlFolder = Nothing
Set OlItems = Nothing
Set OlMail = Nothing
Set OlApp = Nothing

End Sub

方案2：提前筛选符合条件的邮件（更高效） #

使用Restrict方法直接筛选出接收时间晚于指定日期且类型为邮件的项目，减少循环次数，代码更简洁：

Option Explicit

Private Sub btn_extractemails_Click()

Dim OlApp As Object
Dim OlMail As Object
Dim OlItems As Object
Dim OlFolder As Object
Dim j As Integer
Dim strFolder As String
Dim rec_date As Date
Dim filter As String

Set OlApp = GetObject(, "Outlook.Application")
If Err.Number = 429 Then
    Set OlApp = CreateObject("Outlook.Application")
End If

strFolder = ThisWorkbook.Path & "\Extract_test"
rec_date = #8/17/2022#

Set OlFolder = OlApp.GetNamespace("MAPI").Folders("Folder1").Folders("Folder2").Folders("Folder3")

Set OlItems = OlFolder.Items
OlItems.Sort "[ReceivedTime]"

' 构建筛选条件：接收时间>=指定日期，且为邮件类型
filter = "[ReceivedTime] >= '" & Format(rec_date, "ddddd hh:mm AMPM") & "' AND [Class] = 43"
Set OlItems = OlItems.Restrict(filter)

For Each OlMail In OlItems
    If OlMail.Attachments.Count > 0 Then
        For j = 1 To OlMail.Attachments.Count
            OlMail.Attachments.Item(j).SaveAsFile strFolder & "\" & OlMail.Attachments.Item(j).Filename
        Next j
    End If
Next

Set OlFolder = Nothing
Set OlItems = Nothing
Set OlMail = Nothing
Set OlApp = Nothing

End Sub

关键说明： #

• OlMail.Class = 43：43是Outlook中olMailItem的数值常量，后期绑定（用Object声明对象）时无法直接使用常量名，所以用数值代替。
• 筛选日期的格式：Format(rec_date, "ddddd hh:mm AMPM")会把日期转换为Outlook能识别的字符串格式，确保筛选逻辑生效。

内容的提问来源于stack exchange，提问作者Alexandros