Проверка не открыт ли файл другим процессом

Function IsFileOpen(sFilePath As String) As Boolean
's0000205 04.02.2024
'Проверяет не открыт ли файл другим процессом
'Если НЕТ - возвращает TRUE
Dim iFF As Integer
    iFF = FreeFile
On Error Resume Next
    Open sFilePath For Random Access Read Write Lock Read Write As #iFF
    IsFileOpen = (Err.Number <> 0)
    Close #iFF
    Err.Clear
End Function

В коде можно примерно так:

' ...
Dim sDBFilePath$, iVal%
On Error GoTo CompactExternalDB_Err

    sDBFilePath = "d:\Temp\MoneyDB.mdb"
    
'Проверка не открыт ли файл БД другим процессом - если ДА: Error 70 (Permission denied)
    iVal = FreeFile
    Open sDBFilePath For Random Access Read Write Lock Read Write As #iVal
    Close #iVal
    
    ' ... код ...

CompactExternalDB_End:
    On Error Resume Next
    Close #iVal
    Err.Clear
    Exit Function

CompactExternalDB_Err:
    Select Case Err.Number
        Case 70 ' DB File = Permission denied
            MsgBox "База данных: """ & sDBFilePath & vbCrLf & """ открыта другим процессом." & vbCrLf & _
                "Прдолжение не возможно", vbExclamation, csMsgBoxTitle
        Case Else
            MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Function :" & _
                "CompactExternalDB.", vbCritical, "Error!"
    End Select
    Debug.Print "Error " & Err.Number & " (" & Err.Description & ") "
    'Debug.Print "CompactExternalDB_Line: " & Erl & "."
    Err.Clear
    Resume CompactExternalDB_End

Ещё вариант:

Private Function FileIsFree(strPath) As Boolean
's0000205 es 28.10.2005
'Проверяет не открыт ли файл другим процессом
'Если НЕТ - возвращает TRUE
Dim varFile As Variant
On Error GoTo FileIsFree_Error
    varFile = FreeFile
    Open strPath For Input Access Read Lock Read Write As varFile Len = 1
    FileIsFree = True
FileIsFree_Bye:
    On Error Resume Next
    Close varFile
    Exit Function
FileIsFree_Error:
    Err.Clear
    FileIsFree = False
    Resume FileIsFree_Bye
End Function