如何实现Outlook宏等待TIFF转存的PDF完全保存后再附加？

问题分析 #

你当前通过判断文件大小是否大于0来决定是否附加，但Microsoft Print to PDF在开始写入文件时，文件大小就会立刻变为非0，此时文件内容还未完全写入完成，直接附加会导致文件损坏。仅循环等待文件大小>0的逻辑对大文件完全无效。

可行解决方案 #

正确的判断方式是检查文件是否处于系统锁定状态——文件在保存过程中会被系统锁定，无法被其他程序打开，只有当文件完全保存完成后，锁定才会解除。我们可以通过尝试打开文件的方式来判断是否锁定，循环等待直到文件可正常打开，同时增加超时机制避免无限等待。

完整VBA代码实现 #

1. 先添加检查文件锁定的函数：

Private Function IsFileLocked(filePath As String) As Boolean
    Dim fileNum As Integer
    Dim errNum As Integer
    
    On Error Resume Next
    fileNum = FreeFile()
    ' 尝试以独占方式打开文件
    Open filePath For Input Lock Read Write As #fileNum
    Close #fileNum
    errNum = Err.Number
    On Error GoTo 0
    
    ' 错误号70表示文件被锁定
    IsFileLocked = (errNum = 70)
End Function

2. 修改你的等待逻辑，替换原来的大小判断循环：

Dim pdfPath As String
pdfPath = "你的PDF文件完整路径" ' 替换成实际的PDF路径
Dim waitTime As Integer
waitTime = 0
Const MAX_WAIT_SECONDS As Integer = 30 ' 设置最大等待时间，避免无限循环

' 循环等待文件解锁，直到超时
Do While IsFileLocked(pdfPath)
    If waitTime >= MAX_WAIT_SECONDS * 10 Then ' 每次Sleep 100ms，10次就是1秒
        MsgBox "PDF文件保存超时，请检查转换过程是否正常。", vbCritical
        End
    End If
    Sleep 100 ' 等待100毫秒
    waitTime = waitTime + 1
Loop

' 确认文件存在且大小正常
If Dir(pdfPath) = "" Or FileLen(pdfPath) = 0 Then
    MsgBox "Attachment File Corrupted. Must convert the TIFF file to PDF again.", vbCritical
    End
End If

' 这里执行附加文件到邮件的代码
' 示例：
' Dim olApp As Outlook.Application
' Dim olMail As Outlook.MailItem
' Set olApp = New Outlook.Application
' Set olMail = olApp.CreateItem(olMailItem)
' olMail.Attachments.Add pdfPath
' ... 其他邮件设置代码

代码说明 #

• IsFileLocked函数通过尝试以独占读写方式打开文件，捕获错误号70（文件被锁定）来判断文件是否处于保存中。
• 循环中加入了最大等待时间（30秒），防止因转换失败导致宏无限等待。
• 最后额外检查文件是否存在和大小是否非0，作为双重保障。

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