Return the name of the user that currently has workbook open

Suppose you have a XLSM that needs to open a XLSX and have exclusive access to it. However if you are working on a network, there is the possibility that another user already has this XLSX open.
I already have code that will detect if another user has the XLSX open or not. The problem I have is finding a way to determine the name of the user that is currently using this workbook.


What I have tried so far:

1. WriteReservedBy = No point discussing this one further. It doesn't work (websites say so + I tested myself).

2. I found a custom function that looked extremely promising (see code at end of this post) but when tested it couldn't return the name of the user (the strXL returned a complete mess. There was no readable name in it).


My current idea for solving (but I would like help on):

I notice that when another user has a workbook open on a network, Windows creates a hidden workbook while it is open. This hidden workbook exists in the same directory and has the same file name but with a prefix of "~$" added. Now the interesting thing is this: If you look at file properties (in Windows Explorer) the Owner property for the open Workbook remains that of the creator. However the Owner property for the hidden workbook is that of the user who currently has the workbook open. So how do I get the code to return this?


APPENDIX:
This is the code that didn't return the user name. However the LastUser function could be replaced with my idea above.

Option Explicit
'// Just change the file to test here
Private Const strFileToOpen As String = "C:\Test.xlsx"

Public Sub TestVBA()
    If IsFileOpen(strFileToOpen) Then
    MsgBox strFileToOpen & " is already Open" & _
    vbCrLf & "By " & LastUser(strFileToOpen), vbInformation, "File in Use"
    Else
    MsgBox strFileToOpen & " is not open", vbInformation
    End If
End Sub

Private Function IsFileOpen(strFullPathFileName As String) As Boolean
'// VBA version to check if File is Open
'// We can use this for ANY FILE not just Excel!
'// Ivan F Moala
'// http://www.xcelfiles.com
    Dim hdlFile As Long
    
'// Error is generated if you try
'// opening a File for ReadWrite lock >> MUST BE OPEN!
    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

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

The idea that comes to mind for me is to add a Workbook_Open macro into that shared file. The task of that macro would be to write a TXT file into the same directory with a specific name and include the UserName of the person who opened the file. A Workbook_Close macro would delete that file.

Then you can check for that file in your other macros, if it exists you know someone has it open and can read the text file to see who.

That's a brilliant idea, I wouldn't have thought of that! +1

I only have one issue with the suggestion by JBeaucaire. It would only work where the file to test for open by another user is a XLSM and has code added to workbook_open.

Currently my most pressing need for this solution involves XLSX workbooks.

Going back to my idea in the OP, how would I obtain the Owner property of a Windows file using VBA? (I expect API calls will be needed?)

http://stackoverflow.com/questions/1...en-using-vbscr

For the benefit of posterity, the code from there (vb script, tweak as necessary for VBA):

testWorkbookLockFile = "I:\~$test_workbook.xlsx"
Set objFSO = CreateObject("Scripting.FileSystemObject")

If objFSO.FileExists(testWorkbookLockFile) Then
    WScript.Echo "The file is locked by " & GetFileOwner(testWorkbookLockFile)
Else
    WScript.Echo "The file is available"
End If

Function GetFileOwner(strFileName)
    'http://www.vbsedit.com/scripts/security/ownership/scr_1386.asp
    Set objWMIService = GetObject("winmgmts:")
    Set objFileSecuritySettings = _
    objWMIService.Get("Win32_LogicalFileSecuritySetting='" & strFileName & "'")
    intRetVal = objFileSecuritySettings.GetSecurityDescriptor(objSD)

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

Thanks for pointing this out to me +1

I have tidied the code (what is it with coders not declaring variables?) and made a few minor tweaks. But there are some unexpected issues. If anyone is interested in solving, please see code below...

Option Explicit

Private Const strLockedWB_DriveLetter               As String = "Z:"
Private Const strLockedWB_SharePath                 As String = "\\sharednetworkpath"

Private Const strLockedWB_FolderPath_NoDrive        As String = "\shared_folder\"
Private Const strLockedWB_FileNameOnly              As String = "my_test.xlsx"

' this code will not run on Mac due to use of WScript

Public Sub testifworkbookopen()
' should return if workbook is open by another user and the name of the user
'
' currently not working - issues with setting the drive name (for network drives)
' the constants in this module are for testing purposes only - replace with your own versions
' (in the finished product - I would probably have a file or folder picker and assign them to variable strings)

    Dim objFSO                      As Object
    Dim objNetwork                  As Object
    Dim WScript                     As Object
    Dim strLockedWBFullFilePath     As String

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set WScript = CreateObject("WScript.Shell")
    Set objNetwork = CreateObject("WScript.Network")

'   I get an error on the next line. I have checked the drive letter & shared path name. Both are correct...
    objNetwork.MapNetworkDrive "strLockedWB_DriveLetter", "strLockedWB_SharePath"

'   ideally the code should auto detect if the file is on a shared network drive and pick up the drive letter/shared path name by itself
'   I don't know much about WScript.Network but a quick browse of the locals of this leads me to believe that this would be possible.

    strLockedWBFullFilePath = strLockedWB_SharePath & strLockedWB_FolderPath_NoDrive & "~$" & strLockedWB_FileNameOnly

    If objFSO.FileExists(strLockedWBFullFilePath) Then
        WScript.Echo "The file is locked by " & GetFileOwner(strLockedWBFullFilePath)
    Else
        WScript.Echo "The file is available"
    End If
End Sub

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

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

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

It's coming along. See attached WB. The button runs a file picker which will return a message box as to whether it is open or not and the name of the user.

However this thread is not 100% solved. This code can not handle a workbook on a shared network drive. (See post #6). And I don't know WScript well enough to solve this myself. Any help (especially code) would be appreciated for solving this last obstacle.

Any forum user skilled with scripting? Alternatively is there a WScript equivalent of Excel Forum I could ask?

Oops. Thanks for pointing that out!

Strange. Ran some tests on a open file on a shared network drive and the current file picker function works fine. (No need to convert the Drive into a Shared Path name?)

I'll do some further tests to make sure but will mark as solved for now.

Confirm that code is working successfully on files on shared network drives. Final version of code uploaded.

Option Explicit

'\IMPORTANT: Code requires tool reference "Microsoft Scripting Runtime"


Public Sub test_IsWbInUseByAnotherUserAndDisplayName()
'\ this code is for testing/demonstrating the IsWbInUse code

    Dim strTestFilePath As String
    Dim strTestUserName As String

'   workbook picker for end user
'       (should have a filter here to restrict to excel files only. How cover all Excel file types though??)
    strTestFilePath = GetSingleFile_FullPath(Title:="Select workbook")

'   check if WB is in use
    strTestUserName = IsWbInUseByAnotherUserAndDisplayName(strTestFilePath)

'   if WB is in use
    If Len(strTestUserName) > 0 Then
        MsgBox "The file is already in use by " & strTestUserName & "! Goodbye!", vbCritical, "UNABLE TO CONTINUE"
        Exit Sub
    Else
'   if WB is not in use
        strTestUserName = vbNullString
        'add the rest of your code below (presumably to open WB and extract data)
    End If
End Sub

Public Function IsWbInUseByAnotherUserAndDisplayName(ByVal strLockedWBFullFilePath As String) As String
'\ returns if workbook is open by another user and the name of the user
'\ this code will not run on Mac (untested)

    Dim objFSO As Object

'   set the full file path for what the hidden locked file will be if it exists
    strLockedWBFullFilePath = _
        Left(strLockedWBFullFilePath, InStrRev(strLockedWBFullFilePath, Application.PathSeparator)) _
        & "~$" & Mid(strLockedWBFullFilePath, InStrRev(strLockedWBFullFilePath, Application.PathSeparator) + 1)

'   check if this hidden locked file exists
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    If objFSO.FileExists(strLockedWBFullFilePath) Then
        IsWbInUseByAnotherUserAndDisplayName = GetFileOwner(strLockedWBFullFilePath) 'Return user logon name
    Else
        IsWbInUseByAnotherUserAndDisplayName = vbNullString
    End If
End Function

Private Function GetFileOwner(ByVal strFileName As String)
'\ code taken from http://www.vbsedit.com/scripts/security/ownership/scr_1386.asp
    Dim objWMIService           As Object
    Dim objFileSecuritySettings As Object
    Dim objSD                   As Object
    Dim intRetVal               As Integer

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

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

I lost the project so I searched online to find this code again. While I was at it, I updated it.

UPDATE: Just discovered this code doesn't work if the open workbook has read-only file attribute

Thank you for the rep ashishmehra2010.

Unfortunately I don't think it would be possible to return the name of the user where the Excel workbook has a read-only file attribute (because there is no hidden file-lock file created when this workbook is opened).

Having said that, I did some googling and the code below will confirm whether the workbook file is open. You could easily integrate this code into my previous function so that if it appears that no user has it open, run the subroutine below. If this function returns TRUE then this probably means that the workbook is open as a read-only copy (but cant return the UserName)

Public Function fnblnIsWorkbookOpen(ByRef strWbkFileNameAndExt As String) As Boolean
'/ this works on all Excel workbooks, including those with read-only file attribute
    Dim blnResult As Boolean
    Dim xlExcel As Excel.Application

    Err.Clear
    On Error Resume Next
    Set xlExcel = GetObject(, "Excel.Application")

    If Err.Number <> 0 Then
        GoTo ExitProcedure
    End If

    xlExcel.Workbooks(strWbkFileNameAndExt).Activate
    blnResult = (Err.Number = 0)

ExitProcedure:
    Set xlExcel = Nothing
    fnblnIsWorkbookOpen = blnResult
    On Error GoTo 0
End Function