Question How to find user who opened excel in vba

[tdesilva]

How to find out the user who locked the excel file in vba?
I know how to find the owner of the file but owner not always the last user

Private Sub clientList_Click()
Dim FileNm As String
Dim newwb As Workbook
Dim us1 As String
Dim ret
FileNm = "C:\client list.xlsm"
ret = IsWorkBookOpen(FileNm)
If ret = True Then
MsgBox "File is opened by " & GetFileOwner(FileNm) & "."
Else
MsgBox "File is Closed"
End If
end sub

Function IsWorkBookOpen(fileName As String)
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open fileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function

Function GetFileOwner(fileName As String) As String
Dim secUtil As Object
Dim secDesc As Object
Dim File_Shortname As String
Dim fileDir As String
File_Shortname = Dir(fileName)
fileDir = Left(fileName, InStr(1, fileName, File_Shortname) - 1)
Set secUtil = CreateObject("ADsSecurityUtility")
Set secDesc = secUtil.GetSecurityDescriptor(fileDir & File_Shortname, 1, 1)
GetFileOwner = secDesc.owner
End Function


Please let me know how to find the user who locking the file. Thanks

 

[arnelgp]

you can create a function (UserName() in this example) in VBA to get the user of the workbook.
on shared workbook (UserList() in this example), you can list the names of users.

Public Function UserName() As String
UserName = Environ("UserName")
End Function

Public Sub UserList()
Dim users As Variant, row As Integer
users = ActiveWorkbook.UserStatus
For row = 1 To UBound(users, 1)
'get user name
Cells(row, 1) = users(row, 1)
'get date last opened this workbook
Cells(row, 2) = users(row, 2)
'exclusively/shared opened
Cells(row, 3) = Choose(users(row, 3), "Exclusive", "Shared")
Next
End Sub

 

[tdesilva]

Thanks for your reply but this excel file is not a shared file hence not an active workbook to find out users logged in.
I changed slightly the but the array "users" blank and get an error message.
Private Sub clientList_Click()
Dim FileNm As String
Dim ret
Dim users As Variant
Dim row As Integer
Dim User1 As String
Dim Date1 As String
Dim status1 As String
FileNm = "C:\client list.xlsm"
ret = IsWorkBookOpen(FileNm)
If ret = True Then
users = Workbooks("client list.xlsm").UserStatus
For row = 1 To UBound(users, 1)
'get user name
User1 = users(row, 1)
'get date last opened this workbook
Date1 = users(row, 2)
'exclusively/shared opened
status1 = Choose(users(row, 3), "Exclusive", "Shared")
Next

'MsgBox "File is opened by " & User1 & "."
Else
MsgBox "File is Closed"
End If
end sub


Error message comes on statement
users = Workbooks("client list.xlsm").UserStatus

Error message is :
Run time error '9':
Subscript out of range