如何批量检测文件夹内.msg文件是否含附件，现有VBA仅支持下载附件

核心修改逻辑：原有代码只需删除附件保存的逻辑，直接判断outEmail.Attachments.Count属性即可，该属性会直接返回当前邮件的附件总数，大于0即表示存在附件。

修改后的完整代码如下：

Public Sub Check_MSG_Files_Has_Attachments()

    Dim outApp As Object
    Dim outEmail As Object
    Dim msgFiles As String, sourceFolder As String
    Dim fileName As String
    ' 用于统计检测结果
    Dim totalCount As Long, hasAttachCount As Long
    Dim resultLog As String
    
    ' 此处修改为你的msg文件所在文件夹路径，末尾加\*.msg，示例："C:\邮件备份\*.msg"
    msgFiles = ""
    
    sourceFolder = Left(msgFiles, InStrRev(msgFiles, "\"))
    
    On Error Resume Next
    Set outApp = GetObject(, "Outlook.Application")
    If outApp Is Nothing Then
        MsgBox "请先启动Outlook后再运行脚本"
        Exit Sub
    End If
    On Error GoTo 0
    
    totalCount = 0
    hasAttachCount = 0
    resultLog = "检测结果：" & vbCrLf & "====================" & vbCrLf
    
    fileName = Dir(msgFiles)
    While fileName <> vbNullString
        totalCount = totalCount + 1
        
        ' Outlook 2007+用下方代码打开MSG文件，2003版本请替换为注释里的代码
        Set outEmail = outApp.Session.OpenSharedItem(sourceFolder & fileName)
        ' Set outEmail = outApp.CreateItemFromTemplate(sourceFolder & fileName)
        
        ' 核心判断：附件数量大于0即存在附件
        If outEmail.Attachments.Count > 0 Then
            ' 可选：如果要排除签名内嵌图片等无效附件，可以放开以下过滤逻辑，调整大小阈值即可
            ' Dim attachSize As Long, att As Object
            ' attachSize = 0
            ' For Each att In outEmail.Attachments
            '     attachSize = attachSize + att.Size
            ' Next
            ' If attachSize > 10240 Then ' 10KB=10*1024字节
                hasAttachCount = hasAttachCount + 1
                resultLog = resultLog & fileName & "：包含附件" & vbCrLf
            ' End If
        Else
            resultLog = resultLog & fileName & "：无附件" & vbCrLf
        End If
        
        ' 释放邮件对象，避免数千文件检测时内存占用过高
        Set outEmail = Nothing
        
        fileName = Dir
    Wend
    
    ' 输出汇总结果
    resultLog = resultLog & "====================" & vbCrLf & _
                "总检测文件数：" & totalCount & vbCrLf & _
                "含附件文件数：" & hasAttachCount
    ' 结果默认弹窗展示，也可以写入Excel单元格、保存为本地txt文件
    MsgBox resultLog
    ' 同时输出到VBA立即窗口，按Ctrl+G可查看复制
    Debug.Print resultLog
    
End Sub

使用说明 #

• 运行前只需修改msgFiles变量为你的msg文件所在路径，格式为文件夹路径\*.msg
• 若需要过滤邮件签名里的内嵌图片、表情这类非正式附件，放开代码里注释的大小判断逻辑，自行调整阈值即可
• 数千文件检测时建议后台挂起Outlook，避免弹窗卡顿

内容的提问来源于stack exchange，提问作者Mahesh Kumar Duggirala