Preventing File-Writing Race Conditions in VBA

Race conditions are some of the most infuriatingly difficult bugs to fix.

They are unpredictable.  They are difficult to reproduce.  They are nearly impossible to reproduce reliably.  And, owing to end users usually having slower hardware and higher latency network connections and simply using the software more often, they are more likely to occur in production than in development.

And a common source of race conditions is the file system (you leaky abstraction, you!).

Verifying a File Has Been Written to Disk

Microsoft Access–being single-threaded–very rarely suffers from actual race conditions.

However, I have occasionally bumped into this issue over the years.  In most (all?) cases, it involved a call to a third-party library or process.  For example, scanning a document via TWAIN and saving it to a network folder; performing automated image processing via ImageMagick; launching a third-party process and waiting for it to save and close a file; etc.

In all of these situations, the problem generally came down to my VBA code trying to do something with a file that wasn't quite ready to be messed with yet.

To deal with this situation, I wrote the VerifyFileReady procedure shown below.

The routine doesn't really do anything.  Its sole purpose is to sit there and block code execution until the filename you pass to it is ready for use.

I define "ready for use" in four ways:

• The file exists
• The file is not locked by another process
• The file buffers have been flushed
• The file meets a minimum size in bytes (by default, it's not empty)

Unfortunately, there's no way to *really* be sure that the file has been written to disk (you know, leaky abstractions and all).  

So, you can't rely on this to guarantee transactional integrity (i.e., atomicity).  If you need that level of reliability, you'll have to store the binary data inside a BLOB (binary large object) field within the database itself.  That's beyond the scope of this article.

Sample Code

Without further ado, here is the code.  

To get this to compile, you'll either need to implement my Throw routine or replace that line with your preferred approach to raising custom errors.

This code should compile and run under both 32-bit and 64-bit VBA, in Access 2000 (maybe 97?) or later.

Option Compare Database
Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

#If VBA7 Then
    Private Declare PtrSafe Function CloseHandle Lib "kernel32" ( _
                                    ByVal hObject As LongPtr) As Long
#Else
    Private Declare Function CloseHandle Lib "kernel32" _
                                     (ByVal hFile As Long) As Long
#End If

#If VBA7 Then
    'Not Found in Win32API_PtrSafe.TXT
    ' Reference https://www.jkp-ads.com/articles/apideclarations.asp
    Private Declare PtrSafe Function CreateFile Lib "kernel32" Alias _
                                    "CreateFileA" (ByVal lpFileName As String, _
                                                    ByVal dwDesiredAccess As Long, _
                                                    ByVal dwShareMode As Long, _
                                                    ByVal lpSecurityAttributes As Long, _
                                                    ByVal dwCreationDisposition As Long, _
                                                    ByVal dwFlagsAndAttributes As Long, _
                                                    ByVal hTemplateFile As LongPtr) As LongPtr
#Else
    Private Declare Function CreateFile Lib "kernel32" Alias _
                                    "CreateFileA" (ByVal lpFileName As String, _
                                                   ByVal dwDesiredAccess As Long, _
                                                   ByVal dwShareMode As Long, _
                                                   ByVal lpSecurityAttributes As Long, _
                                                   ByVal dwCreationDisposition As Long, _
                                                   ByVal dwFlagsAndAttributes As Long, _
                                                   ByVal hTemplateFile As Long) As Long
#End If

Private Const OPEN_EXISTING = 3
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const GENERIC_ALL = &H10000000

#If VBA7 Then
    Private Declare PtrSafe Function FlushFileBuffers Lib "kernel32" (ByVal hFile As LongPtr) As Long
#Else
    Private Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long
#End If

#If VBA7 Then
    Private Declare PtrSafe Function GetFileSize Lib "kernel32" ( _
                                      ByVal hFile As LongPtr, lpFileSizeHigh As Long) As Long
#Else
    Private Declare Function GetFileSize Lib "kernel32" _
                                     (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
#End If


'perform 64-bit arithmetic (see: http://support.microsoft.com/kb/189862)
Private Type Curr64Bit
    Value As Currency
End Type

Private Type LongsAs64Bit
    LoValue As Long
    HiValue As Long
End Type



'---------------------------------------------------------------------------------------
' Procedure : VerifyFileReady
' Author    : Mike Wolfe
' Source    : https://nolongerset.com/verifyfileready/
' Date      : 1/22/2015
' Purpose   : Confirm that a file is ready for use; commonly used before passing a
'               filename to an outside entity for processing (e.g., a PDF printer,
'               compression utility, email, etc.)
' Parameters:
'   FName           The name of the file
'   MinSizeInBytes  The minimum file size before confirming a file is ready;
'                       by default, the file must be non-empty
'   RetryAttempts   The number of times to retry if a file is not ready
'   DelayInMs       The amount of time to sleep between retries
'   FailureMsg      Set to the reason the file is not ready; passed By Reference so that
'                       the most recent msg will be raised if necessary
'
' Notes     - Acts as a gate: if the file is ready, the program continues on; otherwise
'               an error is thrown after the number of retry ettampts is exhausted
'           - To get the maximum program delay this function will cause, multiply the
'               RetryAttempts by the DelayInMs; by default the program will delay a
'               maximum of 5 seconds (10 attempts * 500 ms delay per retry attempt)
'           - By ready for use, we mean the file meets the following criteria:
'               o the file exists
'               o the file is not locked by another process
'               o the file buffers have been flushed
'               o the file meets the minimum size in bytes (by default, it's not empty)
'           - There's no way to *really* be sure that the file has been written to disk,
'               so this function cannot guarantee transactional integrity
'---------------------------------------------------------------------------------------
'
Sub VerifyFileReady(ByVal FName As String, _
                    Optional ByVal MinSizeInBytes As Long = 1, _
                    Optional ByVal RetryAttempts As Integer = 10, _
                    Optional ByVal DelayInMs As Integer = 500, _
                    Optional ByRef FailureMsg As String = vbNullString)
    Dim FileIsReady As Boolean
    FileIsReady = True

    On Error GoTo Err_VerifyFileReady

    'FlushFileBuffers requires GENERIC_WRITE access
    Dim DesiredAccess As Long
    DesiredAccess = GENERIC_READ Or GENERIC_WRITE

    'Open the file (CreateFile is a generic function that replaces the deprecated OpenFile)
    Dim hFile As Variant  'Long/LongPtr    'File Handle
    Err.Clear    'explicitly flush the Err.LastDllError property
    hFile = CreateFile(FName, DesiredAccess, 0, 0, OPEN_EXISTING, 0, 0)

    Dim FileOpenFailed As Boolean
    Const INVALID_HANDLE_VALUE = -1
    FileOpenFailed = (hFile = INVALID_HANDLE_VALUE)
    If FileOpenFailed Then
        FileIsReady = False
        Select Case Err.LastDllError
        Case 2: FailureMsg = "The system cannot find the file specified."    'ERROR_FILE_NOT_FOUND
        Case 3: FailureMsg = "The system cannot find the path specified."    'ERROR_PATH_NOT_FOUND
        Case 4: FailureMsg = "The system cannot open the file."    'ERROR_TOO_MANY_OPEN_FILES
        Case 5: FailureMsg = "Access is denied."    'ERROR_ACCESS_DENIED
        Case 15: FailureMsg = "The system cannot find the drive specified."    'ERROR_INVALID_DRIVE
        Case 20: FailureMsg = "The system cannot find the device specified."    'ERROR_BAD_UNIT
        Case 21: FailureMsg = "The device is not ready."    'ERROR_NOT_READY
        Case 32: FailureMsg = "The process cannot access the file because it is being used by another process."    'ERROR_SHARING_VIOLATION
        Case 33: FailureMsg = "The process cannot access the file because another process has locked a portion of the file."    'ERROR_LOCK_VIOLATION
        Case Else: FailureMsg = "CreateFile function failed with error number " & Err.LastDllError & "."
        End Select
    End If

    If FileIsReady Then
        'be sure the file has been physically written to disk
        Dim FlushResults As Long
        FlushResults = FlushFileBuffers(hFile)

        Dim FlushFailed As Boolean
        FlushFailed = (FlushResults = 0)
        If FlushFailed Then
            FileIsReady = False
            Select Case Err.LastDllError
            Case 5: FailureMsg = "FlushFileBuffers function failed: Access is denied."    'ERROR_ACCESS_DENIED
            Case Else: FailureMsg = "FlushFileBuffers function failed with error number " & Err.LastDllError & "."
            End Select
        End If
    End If

    'check that the file meets the minimum size requirement
    '   (MinSizeInBytes parameter may not exceed 2GB, but actual
    '    file sizes beyond 2GB are allowed and will be treated correctly)
    If FileIsReady And MinSizeInBytes > 0 Then
        Dim FSize64 As Curr64Bit
        Dim FileSizeLow As Long, FileSizeHigh As Long
        FileSizeLow = GetFileSize(hFile, FileSizeHigh)
        Const GetFileSizeError As Long = &HFFFFFFFF

        If FileSizeLow = GetFileSizeError Then
            FileIsReady = False
            FailureMsg = "Error getting file size."
        ElseIf TwoLongsTo64(FileSizeLow, FileSizeHigh).Value < TwoLongsTo64(MinSizeInBytes, 0).Value Then
            FileIsReady = False
            FailureMsg = "File smaller than minimum size of " & MinSizeInBytes & " byte(s)."
        End If
    End If

    'close the handle or *we* will be the ones locking the file
    If hFile <> INVALID_HANDLE_VALUE Then CloseHandle hFile

    If Not FileIsReady Then
FileNotReady:
        If RetryAttempts > 0 Then
            'we can't just raise an error or the Resume would send us back to the Err.Raise statement;
            '   instead we make a recursive call and decrement the RetryAttempts to prevent a stack overflow
            Sleep DelayInMs
            On Error GoTo 0  'prevent infinite recursion
            VerifyFileReady FName, MinSizeInBytes, RetryAttempts - 1, DelayInMs, FailureMsg
            Exit Sub
        Else
            On Error GoTo 0
            Throw FailureMsg & ": {0}", FName   'see: https://nolongerset.com/throwing-errors-in-vba/
        End If
    End If

    Exit Sub

Err_VerifyFileReady:
    FailureMsg = "Error " & Err.Number & ": " & Err.Description
    Resume FileNotReady
End Sub

'64-bit arithmetic in VBA: http://support.microsoft.com/kb/189862
Function TwoLongsTo64(LowVal As Long, HighVal As Long) As Curr64Bit
    Dim l As LongsAs64Bit
    l.HiValue = HighVal
    l.LoValue = LowVal
    LSet TwoLongsTo64 = l
End Function

External references

Referenced articles

Image by Pexels from Pixabay