附加可能仍在保存中的文件

Question

我的情况是我将 TIFF 文件转换为 PDF 文件并通过电子邮件发送出去。
当我转换 TIFF 时，我使用 Ctrl+P Microsoft Print to PDF 方法手动进行转换。
然后我在 Outlook 中启动一个宏，将其附加到新电子邮件中。

目前，我只是检查（使用 VBA 代码）查看文件大小是否大于 0 并附加。如果它为零，我会收到一条消息并且进程会停止。

If FFile.Size < 0 Then
   MsgBox "Attachment File Corrupted. Must convert the TIFF file to PDF again.", vbCritical
   End
End If

我希望它的功能是这样的：当我启动宏时，它会等待文件完全保存后再附加它。 我尝试了一个循环，但是当文件较大时，它会在文件完全保存之前附加（因此损坏）

For Each FFile In oDir.Items 'There should only be one file here

Do Until FFile.Size > 0 

Sleep 100 

Loop

Answer 1

我不在 Windows 网络上，无法测试网络权限。
也许其他人可以在没有写权限的情况下测试网络文件。

对于设置了只读位的文件，该函数将返回 false，对于 Linux 网络上没有写权限的文件也是如此。 当文件完全写入并关闭时，该函数将返回 true。

Option Explicit

Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)

Function FileAvailable(sFilePath As String) As Boolean
    If Dir(sFilePath) = "" Then
       Debug.Print "File does NOT exist"
       FileAvailable = False
       Exit Function
    Else
       Dim ff As Integer
       Do While True
          ff = FreeFile
          On Error Resume Next
          Open sFilePath For Append As #ff
          Select Case Err.Number
            Case 0 ' File is available
                 Close #ff
                 FileAvailable = True
                 Exit Function
            Case 70 ' File is locked, keep testing until available
                 Sleep 100
            Case 75 ' Read-only bit is set
                 FileAvailable = False
                 Exit Function
            Case Else
                 ' unexpected error, will be printed in the immediate pane
                 Debug.Print "Error: " & Err.Number, Err.Description
          End Select
          On Error GoTo 0
       Loop
    End If
End Function