Get username if file already open

[hstaubyn]

Hi,

I have a bit of code that detects whether or not an excel file is already open - it returns a value 'true' or 'false' and then the rest of the code either executes or stops depending on the answer. This is great as it means that changes can be made to a master document by the code and saved without fear of being lost.

What I would like it to also do is, in the case that the file is already open by someone else on the network, to display the username of the person who has it open.

When you try to manually open an already open file, a dialogue box pops up saying "-Filename-<filename> is locked for editing, by <username>-username-. Open read-only or click notify to (etc.)"

How do you get VBA code to read <username>-username-?

Does anyone know how this can be done?</username></username></filename>

 

[RoryA]

OK. I can't debug until I'm back in the office tomorrow unfortunately.

 

[hstaubyn]

Ok, thanks a lot for the continued help!

 

[RoryA]

Unfortunately I can't get that to work at all either but I'm not sure why, since all the parameters seem correct to me. The only alternative I found is using API calls to loop through all the file locks on a server but, unless you have admin permissions, that will probably fail too - as well as annoying your IT people. I will see if I can find anything else.

 

[hstaubyn]

It does seem strange that this property of an open workbook can't be found. I have looked high and low on the internet and nobody seems to know how to do it.

When you try to open it manually, however, the dialogue box does tell you who has it open so you would expect that information to be retrievable from somewhere.

 

[RoryA]

The information is stored in a small temp file but that file is locked by Excel and I can't find a way to read it while it's locked.

 

[RoryA]

OK, this seems to work for the XML file formats based on some code I saw elsewhere:

Public Function WhoHasXMLWorkbookOpen(strFile As String) As String
   Dim vFileParts

   vFileParts = VBA.Split(strFile, "\")
   vFileParts(UBound(vFileParts)) = "~$" & vFileParts(UBound(vFileParts))
   strFile = VBA.Join(vFileParts, "\")

   If CreateObject("Scripting.FileSystemObject").FileExists(strFile) Then
      WhoHasXMLWorkbookOpen = GetFileOwner(strFile)
   End If
End Function

Public Function GetFileOwner(ByRef strFileName As String) As String
'http://www.vbsedit.com/scripts/security/ownership/scr_1386.asp
   Dim objFileSecuritySettings     As Object
   Dim objSD                       As Object
   Dim intRetVal                   As Integer

   Set objFileSecuritySettings = _
   GetObject("winmgmts:").Get("Win32_LogicalFileSecuritySetting='" & strFileName & "'")
   intRetVal = objFileSecuritySettings.GetSecurityDescriptor(objSD)

   If intRetVal = 0 Then
      GetFileOwner = objSD.Owner.Name
   Else
      GetFileOwner = "Unknown"
   End If
End Function

 

[Artik]

Thread a bit old, but to keep everything together, I decided to continue it.
The last code shown by Rory probably does not solve the problem. At least for me (Win 10, MSO365) I get the result in the form of a group name ("Administrators"), which of course is not the name of the user who opened the Excel file.
But Rory inspired me to write code differently. I noticed that the temporary file ("~ FileName.ext") can be copied and the copy can be edited for reading. When editing a file in Notepad, I can draw the following string from it:

"Artik                                                  A r t i k                                                                                                   "

where non-printed characters ("") are Chr (5), the others are spaces (Chr (32)). With this text string, you probably don't have any problems getting the file username anymore. Because I don't know exactly which part of the string I should download, please choose yourself.

Sub Test()
  'ThisWorkbook must be a saved file!
  'Cannot be started from the cloud!
  MsgBox WhoHasXMLWorkbookOpen(ThisWorkbook.FullName)
End Sub



Function WhoHasXMLWorkbookOpen(strFile As String) As String
    Dim vFileParts
    Dim FSO         As Object
    Dim strTemp     As String
    Dim sFile       As String


    vFileParts = VBA.Split(strFile, "\")
    vFileParts(UBound(vFileParts)) = "~$" & vFileParts(UBound(vFileParts))
    sFile = VBA.Join(vFileParts, "\")


    Set FSO = CreateObject("Scripting.FileSystemObject")


    If FSO.FileExists(sFile) Then
        strTemp = Environ("TEMP")
        FSO.CopyFile sFile, strTemp & "\" & vFileParts(UBound(vFileParts))
        DoEvents
        
        sFile = strTemp & "\" & vFileParts(UBound(vFileParts))
        
        WhoHasXMLWorkbookOpen = GetFileOwner(sFile)
        
        FSO.DeleteFile sFile
        
    End If


End Function



Function GetFileOwner(ByRef strFilename As String) As String
    Dim varArr      As Variant
'    Dim i           As Long
    Dim iFn         As Integer
    Dim strLine     As String
    Dim strTxt      As String


    iFn = FreeFile
    
    Open strFilename For Input As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=iFn]#iFn[/URL] 


    Do Until EOF(iFn)
      Line Input [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=iFn]#iFn[/URL] , strLine
      strTxt = strTxt & strLine
    Loop


    Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=iFn]#iFn[/URL] 
    
'    For i = 1 To Len(strTxt)
'      Debug.Print i & ") " & Asc(Mid(strTxt, i, 1)) & ">" & Mid(strTxt, i, 1) & "<"
'    Next i
    
    varArr = Split(strTxt, Chr(5))


    GetFileOwner = Trim(varArr(1))
    'or
    'GetFileOwner = Trim(varArr(UBound(varArr)))


End Function

Please let me know if this code works for you.

Artik