获取MailItem属性时触发Runtime Error 13类型不匹配错误

问题原因 #

Outlook文件夹里的项目不只有邮件，还可能包含会议邀请、任务请求等其他类型对象，这些对象没有ReceivedTime属性，直接访问就会触发Runtime Error 13 类型不匹配。On Error Resume Next只是跳过错误，但没解决根本问题。

修复后的代码 #

Sub ExportAttachmentsLastWeek()
    Dim objOL As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Dim objFolder As Outlook.Folder
    Dim objItem As Object ' 先声明为通用Object类型
    Dim objMail As Outlook.MailItem
    Dim objAttachment As Outlook.Attachment
    Dim strFolderPath As String
    Dim strFileName As String
    Dim dtmCriteria As Date
    Dim cleanSubject As String

    Set objOL = CreateObject("Outlook.Application")
    Set objNS = objOL.GetNamespace("MAPI")
    Set objFolder = objNS.PickFolder

    If objFolder Is Nothing Then
        Exit Sub
    End If

    strFolderPath = "C:\Users\evansj01\Documents\"
  
    ' 计算一周前的日期
    dtmCriteria = DateAdd("d", -7, Now())
    
    For Each objItem In objFolder.Items
        ' 先判断当前项目是否为邮件类型
        If TypeOf objItem Is Outlook.MailItem Then
            Set objMail = objItem
            ' 检查邮件接收时间是否在近一周内
            If objMail.ReceivedTime >= dtmCriteria Then
                If objMail.Attachments.Count > 0 Then
                    ' 清理邮件主题中的非法字符，避免保存文件出错
                    cleanSubject = Replace(objMail.Subject, ":", "")
                    cleanSubject = Replace(cleanSubject, "\", "")
                    cleanSubject = Replace(cleanSubject, "/", "")
                    cleanSubject = Replace(cleanSubject, "*", "")
                    cleanSubject = Replace(cleanSubject, "?", "")
                    cleanSubject = Replace(cleanSubject, """", "")
                    cleanSubject = Replace(cleanSubject, "<", "")
                    cleanSubject = Replace(cleanSubject, ">", "")
                    cleanSubject = Replace(cleanSubject, "|", "")
                    
                    For Each objAttachment In objMail.Attachments
                        ' 匹配所有常见Excel格式
                        If LCase(Right(objAttachment.FileName, 4)) Like "xlsx" Or _
                           LCase(Right(objAttachment.FileName, 3)) = "xls" Or _
                           LCase(Right(objAttachment.FileName, 4)) = "xlsm" Then
                            strFileName = strFolderPath & cleanSubject & "_" & objAttachment.FileName
                            objAttachment.SaveAsFile strFileName
                        End If
                    Next
                End If
            End If
        End If
    Next
    
    ' 释放对象
    Set objAttachment = Nothing
    Set objMail = Nothing
    Set objFolder = Nothing
    Set objNS = Nothing
    Set objOL = Nothing
End Sub

关键修改点 #

• 对象类型校验：将循环变量声明为Object，遍历过程中用TypeOf判断是否为MailItem，只处理邮件对象
• 日期计算优化：用DateAdd函数更清晰地计算一周前的时间
• 文件名合法性处理：替换邮件主题中的/:*?"<>|等非法字符，避免保存文件时触发错误
• 附件格式扩展：支持xls、xlsx、xlsm三种常见Excel格式

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