执行SetColumns后遍历Outlook附件时出现Object required(错误424)

以下VBA代码试图遍历Outlook指定文件夹中的邮件附件，但运行时在For Each atmt In objItem.Attachments行触发错误424（需要对象）：

Sub apscan()

    Dim objItems As Outlook.Items
    Dim objItem As Object
    Dim objMail As Outlook.MailItem
    Dim strMonth As String
    Dim dReceivedTime As Date
    Dim strReceivedDate As String
    Dim i, n As Long 
    Dim strMsg As String     
    Dim nPrompt As Integer 
    Dim ns As Namespace
    Dim folder As MAPIFolder
    Dim Loc As Range
    Dim atmt As Outlook.Attachment
    Dim atmts As Outlook.Attachments

    ThisWorkbook.Activate

    Set olApp = CreateObject "Outlook.Application")
    Set ns = olApp. GetNamespace ("МАРІ")
    Set folder = ns.Folders("AP").Folders("Inbox")
    Set objItems = folder.Items
    objItems.SetColumns("ReceivedTime")     
    objItems.Sort "[ReceivedTime]", True
    For Each objItem In objItems
        For Each atmt In objItem.Attachments     
            Debug.Print atmt.Filename
        Next atmt
    Next objItem

End Sub

错误原因分析 #

• 语法错误导致对象创建失败：
  • CreateObject "Outlook.Application")缺少左括号，正确写法应为CreateObject("Outlook.Application")
  • GetNamespace的参数拼写错误，需使用"MAPI"而非"МАРІ"，拼写错误会导致无法获取Outlook命名空间对象，后续文件夹、邮件集合的调用都会失效。
• 非邮件对象无Attachments属性：Outlook文件夹的Items集合不仅包含MailItem（邮件），还可能存在会议请求、任务、联系人等其他类型对象，这类对象没有Attachments属性，直接调用会触发“需要对象”错误。

修复后的代码 #

Sub apscan()
    Dim olApp As Outlook.Application
    Dim ns As Namespace
    Dim folder As MAPIFolder
    Dim objItems As Outlook.Items
    Dim objItem As Object
    Dim atmt As Outlook.Attachment

    ThisWorkbook.Activate

    ' 修复语法错误，正确创建Outlook对象和命名空间
    Set olApp = CreateObject("Outlook.Application")
    Set ns = olApp.GetNamespace("MAPI")
    Set folder = ns.Folders("AP").Folders("Inbox")
    Set objItems = folder.Items
    
    objItems.SetColumns("ReceivedTime")
    objItems.Sort "[ReceivedTime]", True

    ' 遍历前先判断对象类型，仅处理邮件对象
    For Each objItem In objItems
        ' 检查是否为邮件类型，避免非邮件对象导致的错误
        If TypeName(objItem) = "MailItem" Then
            For Each atmt In objItem.Attachments
                Debug.Print atmt.Filename
            Next atmt
        End If
    Next objItem

    ' 释放对象，避免内存泄漏
    Set atmt = Nothing
    Set objItem = Nothing
    Set objItems = Nothing
    Set folder = Nothing
    Set ns = Nothing
    Set olApp = Nothing
End Sub

修复说明 #

1. 修正了CreateObject的括号缺失和GetNamespace的参数拼写错误，确保能正确获取Outlook对象。
2. 添加TypeName(objItem) = "MailItem"判断逻辑，只对邮件对象执行附件遍历操作，规避非邮件对象的属性调用错误。
3. 增加对象释放语句，避免长期运行导致的内存泄漏问题。

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