View Full Version : show username if file is open
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
10-12-2012, 02:38 AM
Sub GetTheNameAPP()
MsgBox "Application username is: " & Application.UserName
End Sub
mancubus
10-12-2012, 03:12 AM
hi.
see if solution by ivan f moala in post #12 helps here:
http://windowssecrets.com/forums/showthread.php/60664-Who-has-File-Open-(VBA-Excel-2003-Win-XP)
I found this code. It worked once. Now it keeps returning the name of the user foubnd the first time the macro run.
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
Mancubus,
i get an error by defining j
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)
ger
To keep things simple:
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
I get the message that the file is in use but the name of the user is not displayed. (see attachement)
Ger
That's because xlsx and xlsm files are zipped files.
Kenneth Hobs
10-12-2012, 09:33 AM
The LastUser method was designed for xls file type. The structure of xlsm is different.
'===========================================
'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
@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')
It looks like it's impossible to get the username for an open xlsm or xlsx file.
Ger
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.