Excel 2010 VBA - find name of the user of an open excel file

Originally Posted by TMShucks

If the workbook resides on a central server somewhere, and if it is macro enabled, you could write a text file to a fixed location with the user's log in ID, and the time the file was opened.

You could then interrogate the text file. In fact, you could probably append to it so you'd have a history of who uses the file.

Just an idea ...


Regards, TMS

Thanks TMS, I like the Idea, greatly appreciate it

Originally Posted by TMShucks

You're welcome.



If you are satisfied with the solution(s) provided, please mark your thread as Solved.


New quick method:
Select Thread Tools-> Mark thread as Solved. To undo, select Thread Tools-> Mark thread as Unsolved.

Or you can use this way:

How to mark a thread Solved
Go to the first post
Click edit
Click Go Advanced
Just below the word Title you will see a dropdown with the word No prefix.
Change to Solved
Click Save


You may also want to consider thanking those people who helped you by clicking on the little star at the bottom left of their reply to your question.

Thanks TMS, but I will wait a little longer as I am hoping someone will be able to figure out how to directly from my open workbook to get the user's information on a workbook someone else has open on the server. I am working on your idea now and then if someone comes up with the solution I really want I will close it.

Thanks for all the help

Originally Posted by yudlugar

I suppose you could use something like:

MsgBox "Open since " & CreateObject("scripting.filesystemobject").getfile("E:\Book1.xls").datelastaccessed

to find out how long it has been opened. I'm not sure how to get the user but I'll have a think.

Edit: According to google:

Option Explicit

Sub macro_1()
MsgBox "Open since " & CreateObject("scripting.filesystemobject").getfile("E:\Book1.xls").datelastaccessed & " by " & LastUser("E:\Book1.xls")
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 & 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

then you probably want something along the lines of:

Option Explicit

Function FileLocked(strFileName As String) As Boolean
   On Error Resume Next
   ' If the file is already opened by another process,
   ' and the specified type of access is not allowed,
   ' the Open operation fails and an error occurs.
   Open strFileName For Binary Access Read Write Lock Read Write As #1
   Close #1
   ' If an error occurs, the document is currently open.
   If Err.Number <> 0 Then
      ' Display the error number and description.
      MsgBox "Error #" & Str(Err.Number) & " - " & Err.Description
      FileLocked = True
      Err.Clear
   End If
End Function

Sub test()
    Debug.Print FileLocked("C:\Users\ooo\Desktop\test.xlsx")

End Sub

to see if the file is locked

0

Hello yudlugar,
I tried the above scripts but did not have any good luck with it. However, I found this from Jeff Grove that works very well for me

Function GetFileOwner(fileDir As String, fileName As String) As String

'On Error Resume Next
Dim secUtil As Object
Dim secDesc As Object
Set secUtil = CreateObject("ADsSecurityUtility")
Set secDesc = secUtil.GetSecurityDescriptor(fileDir & fileName, 1, 1)
GetFileOwner = secDesc.owner
End Function


Thanks everyone for all the help