Public Function fnDoesFileAlreadyOpen( _
  strFileName As String) As Boolean
    Dim hFile As Long
    
    On Error GoTo HandleErr
    
    hFile = FreeFile()
    
    Open strFileName For Output As hFile
    
    Close hFile

ExitHere:
    Exit Function

HandleErr:
    Select Case Err
        Case  70 
            MsgBox "Файл уже используется."
            fnDoesFileAlreadyOpen = True
        Case Else
            MsgBox Err.Number & " " & Err.Description
    End Select
    Resume ExitHere
End Function

Private Declare Function lopen Lib "kernel32" Alias "_lopen" ( _
  ByVal lpPathName As String, _
  ByVal iReadWrite As Long) As Long

Private Declare Function GetLastError Lib "kernel32" () As Long

Private Declare Function lclose Lib "kernel32" Alias "_lclose" ( _
  ByVal hFile As Long) As Long

Public Function fnDoesFileAlreadyOpen( _
  strFileName As String) As Boolean
    Dim hFile As Long
    Dim lngError As Long

    hFile = - 1 
    lngError =  0 

    hFile = lopen(strFileName, &H10)

    If hFile = - 1  Then
        lngError = Err.LastDllError
    Else
        lclose (hFile)
    End If

    If (hFile = - 1 ) And (lngError =  32 ) Then
       MsgBox "Файл уже используется."
       fnDoesFileAlreadyOpen = True
    Else
       fnDoesFileAlreadyOpen = False
    End If
End Function

    Open strFileName For Append As hFile