Sprawdzenie czy plik jest otwarty przez inny program

Znalazłem ciekawy kawałek kodu w internecie do sprawdzenia czy dany plik nie został otwarty w innej aplikacji. np. plik Excel-a. Kod ten wykorzystuje API Windows.

Option Explicit

'===========================================

'http://www.xcelfiles.com/IsFileOpenAPI.htm

'===========================================

'// Note we use an Alias here as using the Actual
'// function name will not be accepted! ie underscore= "_lopen"
Private Declare Function lOpen _
                          Lib "kernel32" _
                              Alias "_lopen" ( _
                              ByVal lpPathName As String, _
                              ByVal iReadWrite As Long) _
                              As Long

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

'// Don't use these...here for Info only

Private Const OF_SHARE_COMPAT = &H0
Private Const OF_SHARE_DENY_NONE = &H40
Private Const OF_SHARE_DENY_READ = &H30
Private Const OF_SHARE_DENY_WRITE = &H20

'// Use the Constant below
'// OF_SHARE_EXCLUSIVE = &H10
'// OPENS the FILE in EXCLUSIVE mode,
'// denying other processes AND the current process both read and write
'// access to the file. If the file has been opened in any other mode for read or
'// write access _lopen fails. This is important as if you open the file in the
'// current process = Excel BUT loose its handle
'// then you CANNOT open it again in the SAME session!
Private Const OF_SHARE_EXCLUSIVE = &H10

'If the Function succeeds, the return value is a File handle.
'If the Function fails, the return value is HFILE_ERROR = -1

Private Function IsFileAlreadyOpen(strFullPath_FileName As String) As Boolean
'// Ivan F Moala
'// http://www.xcelfiles.com
    Dim hdlFile As Long
    Dim lastErr As Long
    hdlFile = -1
    '// Open file for Read/Write and Exclusive Sharing.
    hdlFile = lOpen(strFullPath_FileName, OF_SHARE_EXCLUSIVE)
    '// If we can't open the file, get the last error.
    If hdlFile = -1 Then
        lastErr = Err.LastDllError
    Else
        '// Make sure we close the file on success!
        lClose (hdlFile)
    End If
    '// Check for sharing violation error.
    IsFileAlreadyOpen = (hdlFile = -1) And (lastErr = 32)
End Function

Private Function LastUser(strPath As String) As String
'// Code by Helen from http://www.visualbasicforum.com/index.php?s=
'// This routine gets the Username of the File In Use
'// Credit goes to Helen for code & Mark for the idea
'// Insomniac for xl97 inStrRev
'// Amendment 25th June 2004 by IFM
'// : Name changes will show old setting
'// : you need to get the Len of the Name stored just before
'// : the double Padded Nullstrings

    Dim strXl  As String
    Dim strFlag1 As String, strflag2 As String
    Dim i As Integer, j As Integer
    Dim hdlFile As Long
    Dim lNameLen As Byte

    strFlag1 = Chr(0) & Chr(0)
    strflag2 = Chr(32) & Chr(32)

    hdlFile = FreeFile
    Open strPath For Binary As #hdlFile
    strXl = Space(LOF(hdlFile))
    Get 1, , strXl
    Close #hdlFile
    j = InStr(1, strXl, strflag2)
    
#If Not VBA6 Then
    '// Xl97
    For i = j - 1 To 1 Step -1
        If Mid(strXl, i, 1) = Chr(0) Then Exit For
    Next
    i = i + 1
#Else
    '// Xl2000+
    i = InStrRev(strXl, strFlag1, j) + Len(strFlag1)
#End If

    '// IFM
    lNameLen = Asc(Mid(strXl, i - 3, 1))
    LastUser = Mid(strXl, i, lNameLen)

End Function

Wykorzystanie przykładowe znajduje się w kodzie poniżej:

Sub TestAPI()
'// We can use this for ANY FILE not just Excel!
    Dim t      As String
    t = "C:\Users\Przemek\Documents\pivot from db.xls"
    If IsFileAlreadyOpen(t) Then
        MsgBox t & " is already Open" & vbCrLf & "By " & LastUser(t), vbInformation, "File in Use"
    Else
        MsgBox "File is NOT open", vbInformation
    End If
End Sub

Trzeba zaznaczyć że funkcje są zadeklarowane jako prywatne i nie będą widoczne poza modułem w który zostały wklejone. Jeżeli ktoś chciał by je wykorzystać w innym miejscu konieczna może się okazać zmiana Private na Public.