1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96
|
Option Explicit
'===========================================
'http://www.xcelfiles.com/IsFileOpenVBA.htm
'===========================================
Sub TestVBA()
'// Just change the file to test here
Dim strFileToOpen As String
strFileToOpen = "D:\Document\Mes documents\Classeurfermé_test_DATA.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
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 |
Partager