show username if file is open

[Ger]

Good morning,

i'm using excell 2010 dutch version.
I'm looking for a code that checks if a file is opened by a user and if so shows the username of the user.

Thx,

Ger

[patel]

[VBA]Sub GetTheNameAPP()
MsgBox "Application username is: " & Application.UserName
End Sub[/VBA]

[mancubus]

hi.
see if solution by ivan f moala in post #12 helps here:
http://windowssecrets.com/forums/sho...el-2003-Win-XP)

[Ger]

I found this code. It worked once. Now it keeps returning the name of the user foubnd the first time the macro run.

[VBA]Sub TestVBA()
'// Just change the file to test here
Const strFileToOpen As String = "P:\IBIV\Produktie\PE_ZML\BM1Hrl_2012.xlsm"
If IsFileOpen(strFileToOpen) Then
MsgBox strFileToOpen & " is already Open" & _
vbCrLf & "By " & getusername, vbInformation, "File in Use"
Else
MsgBox strFileToOpen & " is not open", vbInformation
End If
End Sub
Function IsFileOpen(strFullPathFileName As String) As Boolean
Dim hdlFile As Long
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
Function getusername()
getuser = (Environ$("Username"))
getusername = getuser
End Function[/VBA]

[Ger]

Mancubus,
i get an error by defining j


[VBA]Open strPath For Binary As #1
text = Space(LOF(1))
Get 1, , text
Close #1
j = InStr(1, text, strflag2)
i = InStrRev(text, strFlag1, j) + Len(strFlag1)
LastUser = Mid(text, i, j - i)[/VBA]


ger

[snb]

To keep things simple:

[VBA]
Sub snb()
c00 = "G:\OF\adressen.xls"

c02 = c00 & " is niet in gebruik"
If IsFileOpen(c00) Then c02 = c00 & " is in gebruik" & String(2, vbLf) & "Gebruiker: " & LastUser(c00)
MsgBox c02
End Sub

Function IsFileOpen(c01) As Boolean
On Error Resume Next

Open c01 For Random Access Read Write Lock Read Write As #1
Close
IsFileOpen = Err.Number <> 0
End Function

Function LastUser(c01) As String
Open c01 For Binary As #1
c02 = Input(LOF(1), 1)
Close #1

j = InStr(c02, Space(2))
i = InStrRev(c02, String(2, Chr(0)), j) + 3
LastUser = Mid(c02, i, j - i)
End Function[/VBA]

[Ger]

I get the message that the file is in use but the name of the user is not displayed. (see attachement)


Ger

[snb]

That's because xlsx and xlsm files are zipped files.

[Kenneth Hobs]

The LastUser method was designed for xls file type. The structure of xlsm is different.

[VBA]
'===========================================
'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"


Public myDir As String
Public StartLine As Long
Public HowManyLines As Long
Public myFile
Public i
Public adate
Public ws
Public ActWork
Public NewWrkBk


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
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

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


Function LastUserWP(strPath As String) As String
Dim s 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
s = strXl
Get 2, , strXl
s = s + 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))
LastUserWP = Mid(strXl, i, lNameLen)
End Function
[/VBA]

[snb]

@KH

I can only see a difference in the checking whether a file is open.
That's where the API comes in.

The retrieving of the last user is unaltered.

Or do I miss something ?

Both lastuser functions error out
the first one in: j = InStr(1, strXl, strflag2)

the second one in : Get 2, , strXl

(BTW I don't see any purpose for the variable 's')

[Ger]

It looks like it's impossible to get the username for an open xlsm or xlsx file.

Ger