VBA批量打印Outlook MAPI文件夹PDF时FileLen行偶发文件未找到错误如何调试

问题根源排查 #

你遇到的偶发「文件未找到」错误由以下几个常见原因共同导致：

• 文件名非法字符未处理：仅替换了文件名中的空格，未过滤Windows不允许的文件名特殊字符（\ / : * ? " < > |），会导致Att.SaveAsFile执行时实际保存的文件名和你定义的NewFileName不一致，前置的FSO.FileExists判断可能命中缓存或者延迟，实际文件不存在。
• 杀毒软件扫描冲突：办公环境的终端杀毒软件会对新写入的PDF文件执行即时扫描，扫描期间会临时锁定文件或者暂挂文件访问权限，VBA内置的FileLen函数对文件锁的兼容性远差于FSO对象的方法，就会触发文件未找到错误。
• 大小校验逻辑缺陷：初始化NewLen=1，如果附件保存失败生成0字节空文件，校验逻辑会直接通过，且没有重试机制应对临时锁的情况。
• 异步清理的边界冲突：调用Shell执行删除命令是异步操作，虽然做了文件夹大小判断，极端场景下上一轮清理的句柄未释放，新写入的文件会被临时标记为待删除，访问时触发错误。

修复方案 #

1. 新增文件名非法字符过滤逻辑 #

在生成NewFileName前先清理所有非法字符，在代码中新增自定义函数：

Function CleanFileName(FileName As String) As String
    Dim IllegalChars As Variant
    Dim i As Integer
    IllegalChars = Array("\", "/", ":", "*", "?", """", "<", ">", "|")
    CleanFileName = FileName
    For i = LBound(IllegalChars) To UBound(IllegalChars)
        CleanFileName = Replace(CleanFileName, IllegalChars(i), "_")
    Next i
End Function

调用时把原来的NoSpace = Replace(Att.FileName, " ", "_")改成：

NoSpace = CleanFileName(Replace(Att.FileName, " ", "_"))

2. 替换FileLen为FSO方法并增加错误重试 #

把原来的大小校验循环替换为带错误捕获的逻辑，避免临时锁导致的报错：

' 替换原来的大小校验段代码
NewLen = 0
OldLen = 0
Dim RetryCount As Integer
RetryCount = 0
' 最多重试10次，每次间隔100ms，应对临时锁
Do While RetryCount < 10
    On Error Resume Next
    If FSO.FileExists(NewFileName) Then
        NewLen = FSO.GetFile(NewFileName).Size
        If Err.Number = 0 Then
            ' 连续两次大小一致且大于100字节判定为有效PDF
            If NewLen = OldLen And NewLen > 100 Then
                Exit Do
            End If
            OldLen = NewLen
            RetryCount = 0 ' 重置重试计数
        Else
            Err.Clear
            RetryCount = RetryCount + 1
        End If
    Else
        RetryCount = RetryCount + 1
    End If
    On Error GoTo 0
    Sleep 100
    DoEvents
Loop
' 超过重试次数直接跳过当前文件，避免卡死
If RetryCount >= 10 Then
    Debug.Print "文件校验失败，跳过：" & NewFileName
    GoTo NextAttachment
End If

同时在Next Att行之前添加跳转标签NextAttachment:。

3. 优化临时文件清理逻辑 #

把原来的Shell调用删除改成FSO直接删除文件，避免异步操作的边界问题：

' 替换原来的Shell删除和大小判断逻辑
Dim TempFile As Scripting.File
On Error Resume Next
For Each TempFile In TempFolder.Files
    TempFile.Delete True
Next
On Error GoTo 0

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