Option Explicit

'===========================================
'http://www.xcelfiles.com/IsFileOpenVBA.htm
'===========================================

Sub TestVBA()
'// Just change the file to test here
Const strFileToOpen As String = "C:\aaa.xls"

    If IsFileOpen(strFileToOpen) Then
        MsgBox strFileToOpen & " is already Open" & _
            vbCrLf & "By " & LastUser(strFileToOpen), vbInformation, "File in Use"
    Else
        MsgBox strFileToOpen & " is not open", vbInformation
    End If
End Sub

Function IsFileOpen(strFullPathFileName As String) As Boolean
'// VBA version to check if File is Open
'// We can use this for ANY FILE not just Excel!
'// Ivan F Moala
'// http://www.xcelfiles.com
Dim hdlFile As Long

    '// Error is generated if you try
    '// opening a File for ReadWrite lock >> MUST BE OPEN!
    On Error GoTo FileIsOpen:
    hdlFile = FreeFile
    Open strFullPathFileName For Random Access Read Write Lock Read Write As hdlFile
    IsFileOpen = False
    Close hdlFile
    Exit Function
FileIsOpen:
    '// Someone has it open!
    IsFileOpen = True
    Close hdlFile
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
        End If
    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

Sub subPlikDoOdczytu()

' trzeba wylaczyc komunikaty oraz odswiezanie ekranu
' bo jezeli druga osoba otwiera juz otwarty plik
' to excel nas o tym powiadamia
' a nie chcemy zeby uzytkownik to widzial
Application.ScreenUpdating = False  ' wylaczenie odswiezania

Application.DisplayAlerts = False ' wylaczenie komunikatow
Workbooks.Open Filename:="D:\Zeszyt1.xls"
Application.DisplayAlerts = True ' wlaczenie komunikatow

' jezeli ten sam plik jest otwierany
' przez druga osobe to otwiera sie w trybie do odczytu
If Workbooks("Zeszyt1").ReadOnly Then
  MsgBox "Otwórz za 5 min."
  Workbooks("Zeszyt1.xls").Close SaveChanges:=False
End If

Application.ScreenUpdating = True ' wlaczenie odswiezania

End Sub