Outlook 2010接收带附件邮件时Attachments.Count返回0，自动存附件失效

我帮你分析下这个问题——你说首次应用规则到收件箱正常，但新邮件来的时候脚本明明执行了（测试代码报错证明），却没保存附件，这种情况大概率是脚本细节或者规则设置的小问题，咱们一步步排查：

一、先把VBA脚本补全并修复潜在问题 #

你的代码片段没写完循环，而且还有几个容易踩坑的点，我整理了一个完整且健壮的版本：

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    Dim dateFormat As String
    Dim fileName As String
    
    ' 附件保存路径，记得确保这个文件夹存在（下面会自动创建）
    saveFolder = "C:\temp"
    
    ' 关键：如果目标文件夹不存在，自动创建，避免路径错误导致保存失败
    If Dir(saveFolder, vbDirectory) = "" Then
        MkDir saveFolder
    End If
    
    ' 优化时间戳格式，用秒数减少文件名重复概率，避免小时分钟连在一起的奇怪格式
    dateFormat = Format(itm.ReceivedTime, "yyyy-mm-dd H-mm-ss ")
    
    ' 遍历邮件的所有附件
    For Each objAtt In itm.Attachments
        ' 可选：过滤掉签名里的嵌入图片，如果你需要保存所有附件可以删掉这行判断
        If objAtt.Type <> olEmbeddeditem Then
            ' 生成带时间戳的文件名，防止重名覆盖
            fileName = dateFormat & objAtt.FileName
            ' 保存附件，注意路径分隔符的拼接
            objAtt.SaveAsFile saveFolder & "\" & fileName
        End If
    Next objAtt
    
    ' 释放对象，避免内存泄漏
    Set objAtt = Nothing
End Sub

脚本里的关键修复点： #

• 补全了循环变量（你原来写的For Each o...里的o没定义，换成了声明好的objAtt）
• 增加了文件夹自动创建逻辑：很多时候保存失败就是因为目标文件夹不存在，这行代码能解决这个问题
• 优化了时间戳格式：把Hmm改成H-mm-ss，既避免格式混乱，又用秒数降低文件名重复的概率
• 增加了嵌入附件过滤：默认跳过签名里的图片，如果你需要保存所有附件，直接删掉If objAtt.Type <> olEmbeddeditem Then这行和对应的End If就行

二、检查Outlook规则的设置是否正确 #

脚本执行了但没保存附件，还要确认规则是否真的正确触发了新邮件：

• 打开Outlook的「规则和通知」，找到你的规则，仔细核对触发条件：比如是不是只针对特定发件人/主题？新收到的测试邮件是否满足这些条件？
• 确认规则的执行动作是「运行脚本」，并且选择的是你刚修复的saveAttachtoDisk宏（别选错了其他脚本）
• 检查规则是否被禁用：规则列表里的复选框一定要勾选上
• 实在不行就重新创建规则：有时候Outlook的规则会有缓存问题，删掉旧规则重新建一次，确保每一步都选对

三、确认Outlook的宏安全设置 #

虽然脚本能执行，但还是要确保信任中心的设置没卡壳：

1. 打开Outlook，点「文件」→「选项」→「信任中心」→「信任中心设置」
2. 选「宏设置」，勾选「启用所有宏」（如果是测试环境的话，正式环境可以选「启用签署的宏」，但需要给你的脚本签名）
3. 别忘了勾选「信任对VBA项目对象模型的访问」，有些版本的Outlook需要这个设置才能让脚本正常访问邮件对象

四、做个测试验证 #

修复完脚本和规则后，给自己发一封带附件的测试邮件：

• 去C:\temp看看有没有生成带时间戳的附件
• 如果还是不行，加个调试日志看看脚本到底有没有遍历到附件：在objAtt.SaveAsFile那行上面加这段代码，会把处理记录写到C:\outlook_attach_log.txt里，方便排查问题：

  ' 调试用的日志代码
  Open "C:\outlook_attach_log.txt" For Append As #1
  Print #1, Now() & " - 处理邮件：" & itm.Subject & "，找到附件：" & objAtt.FileName
  Close #1
  

内容的提问来源于stack exchange，提问作者Nguyễn Hữu Bảo Kiến