VBA - Outlook不删除附件

Sub RemoveAttachments()
    Dim olApp As Outlook.Application
    Dim olNamespace As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder
    Dim olItem As Outlook.MailItem
    Dim olAttachment As Outlook.Attachment
    
    ' 创建Outlook应用程序对象
    Set olApp = New Outlook.Application
    
    ' 获取当前Outlook会话
    Set olNamespace = olApp.GetNamespace("MAPI")
    
    ' 获取收件箱文件夹
    Set olFolder = olNamespace.GetDefaultFolder(olFolderInbox)
    
    ' 遍历收件箱中的所有邮件
    For Each olItem In olFolder.Items
        ' 判断是否为邮件
        If olItem.Class = olMail Then
            ' 遍历邮件中的所有附件
            For Each olAttachment In olItem.Attachments
                ' 删除附件
                olAttachment.Delete
            Next olAttachment
        End If
    Next olItem
    
    ' 释放对象
    Set olAttachment = Nothing
    Set olItem = Nothing
    Set olFolder = Nothing
    Set olNamespace = Nothing
    Set olApp = Nothing
End Sub