Bonjour Berkowil,
Dans un module standard, copie ce qui suit, et
tu exécutes la procédure Test en prenant soin
d'indiquer le chemin et le fichier que tu veux tester.
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
'------------------------------------------------
Sub TestAPI(file As String)
'// We can use this for ANY FILE not just Excel!
If IsFileAlreadyOpen(file) Then
MsgBox Chemin & file & " est déjà ouvert" &
_
vbCrLf & "By " & LastUser(Chemin & file), _
vbInformation, "Fichier déjà utilisé"
Else
MsgBox "File is NOT open", vbInformation
End If
End Sub
'------------------------------------------------
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 & Mike for the idea
'// Insomiac 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
'------------------------------------------------
Sub test()
TestAPI ("c:usersdmdocumentsclasseur1.xls")
End Sub
"berkowil" a écrit dans le message de
groupe de discussion :
Bonjour,
j'ai sur le reseau un fichier nommé donnees.xml, j'aimerai savoir,
lorsqu'il
es t ouvert le loggin de l'utlisateur qui travaille dessus
Bonne journée a tous
Bonjour Berkowil,
Dans un module standard, copie ce qui suit, et
tu exécutes la procédure Test en prenant soin
d'indiquer le chemin et le fichier que tu veux tester.
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
'------------------------------------------------
Sub TestAPI(file As String)
'// We can use this for ANY FILE not just Excel!
If IsFileAlreadyOpen(file) Then
MsgBox Chemin & file & " est déjà ouvert" &
_
vbCrLf & "By " & LastUser(Chemin & file), _
vbInformation, "Fichier déjà utilisé"
Else
MsgBox "File is NOT open", vbInformation
End If
End Sub
'------------------------------------------------
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 & Mike for the idea
'// Insomiac 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
'------------------------------------------------
Sub test()
TestAPI ("c:usersdmdocumentsclasseur1.xls")
End Sub
"berkowil" a écrit dans le message de
groupe de discussion :
Bonjour,
j'ai sur le reseau un fichier nommé donnees.xml, j'aimerai savoir,
lorsqu'il
es t ouvert le loggin de l'utlisateur qui travaille dessus
Bonne journée a tous
Bonjour Berkowil,
Dans un module standard, copie ce qui suit, et
tu exécutes la procédure Test en prenant soin
d'indiquer le chemin et le fichier que tu veux tester.
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
'------------------------------------------------
Sub TestAPI(file As String)
'// We can use this for ANY FILE not just Excel!
If IsFileAlreadyOpen(file) Then
MsgBox Chemin & file & " est déjà ouvert" &
_
vbCrLf & "By " & LastUser(Chemin & file), _
vbInformation, "Fichier déjà utilisé"
Else
MsgBox "File is NOT open", vbInformation
End If
End Sub
'------------------------------------------------
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 & Mike for the idea
'// Insomiac 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
'------------------------------------------------
Sub test()
TestAPI ("c:usersdmdocumentsclasseur1.xls")
End Sub
"berkowil" a écrit dans le message de
groupe de discussion :
Bonjour,
j'ai sur le reseau un fichier nommé donnees.xml, j'aimerai savoir,
lorsqu'il
es t ouvert le loggin de l'utlisateur qui travaille dessus
Bonne journée a tous