Determin if a workbook is already opened by another user.

[BKoetting]

I have a macro that updates several workbooks. I need to be able to determin if the workbook is already open. I'm looking for something like a Workbooks property that returns true or false value on the current state of the workbook.

 

[Greg Truby]

Re: Determin if a workbook is already opened by another user

To me the challenge is not so much the who -- that will pop up in a dialog box that says "John Doe has the workbook locked..." when another user tries to open the workbook. The challenge is how to avoid the case where people open it and then leave for the day. We run two shifts and sometimes someone on the other shift has opened a workbook w/o closing it and their computer is locked up. Unless one can find someone with admin privileges to boot them or else one is willing to power down the computer (either of which risks losing any unsaved edits) then the only other option is to bake in some sort of a timer that will do the boot after some many minutes of no selection changes or something similar.

One could always create a logging overlay in VBA that tracked who had opened a workbook. But, again, for me the who is less important than whether that person is still in the office.

In looking into this issue, I did find this post on VBA Express. However then I tried out the code posted by Kenneth Hobs, it did not work for me.

 

[Jaafar Tribak]

Re: Determin if a workbook is already opened by another user

Take a look at Ivan's post#12 HERE

 

[Greg Truby]

Re: Determin if a workbook is already opened by another user

Hi Jaafar! Long time, no see. Hope you've been well.

The function in Ivan's post is the same function that I'd found posted by Kenneth. Perhaps that worked with older workbook formats. But I was unable to get good results using that function on a workbook created in Excel 2016.

 

[Jaafar Tribak]

Re: Determin if a workbook is already opened by another user

Hi Greg! I am doing well. Thanks... I don't see much of you here these days.

The function in Ivan's post is the same function that I'd found posted by Kenneth. Perhaps that worked with older workbook formats. But I was unable to get good results using that function on a workbook created in Excel 2016.

Sorry, I didn't see the VBA Express post... I have never used that function but gave it a shot today and,like you said, it didn't work.

I did a quick search on the subject and came accross this NetFileGetInfo API function which sounds like the right solution.. However, its use seems to require administrator privileges so I don't think it is worthwhile.

 

[Jaafar Tribak]

Re: Determin if a workbook is already opened by another user

You can use the following tacky hack to find out the user who currently has the workbook open:

1- Place this code in the ThisWorkbook Module : (This will tag the workbook when opened as ReadWrite)

Private Sub Workbook_Open()
    If Not Me.ReadOnly Then
        Me.Names.Add Name:="CurrentUser", RefersTo:=Environ("username"), Visible:=False
        Application.EnableEvents = False
        Me.Save
        Application.EnableEvents = True
     End If
End Sub

2- And use this function to retrieve the name of the remote user from the workbook Tag :

Function Current_User_Of_File(ByVal FilePathName As String) As String

    Dim oXl As Excel.Application
    Dim oWb As Workbook
    
    On Error GoTo Xit
    
    Set oXl = New Application
    With oXl
        .Visible = False
        .EnableEvents = False
         Set oWb = .Workbooks.Open(FilePathName, False, True)
        Current_User_Of_File = Evaluate(oWb.Names("CurrentUser").Value)
        .Quit
    End With
    Exit Function
Xit:
    oXl.Quit

End Function

Sub Test()
    MsgBox Current_User_Of_File(ThisWorkbook.FullName)
End Sub

 

[Greg Truby]

Re: Determin if a workbook is already opened by another user

Agreed. If I were going to try to do something that would get the name, then your approach is undoubtedly what I'd use (stash the name in a hidden workbook name or else a custom workbook property). And, since .DocumentProperty objects do not have a .visible property and .Name objects do allow one to make them invisible, like you, I'd lean towards using a .Name object.

But like I said in a previous post, to me, finding out the user's name is of limited utility - and I already get that from Excel itself. To me, the whole exercise only becomes worth pursuing when your code can force the workbook closed because whoever has it open cannot be reached and asked to close it, i.e. building in a timer that resets whenever a selection change or change event gets raised and then the timer closes the workbook if it expires (examples of which exist).

Good to see you, my friend.

 

[pbornemeier]

I am embarrassed to say that I did not save the origin info for this file (which I modified somewhat and may have created in full), but the above thread came up during my search on multiple instances in Excel. I believe this code will return the name as desired in the OP (3 years ago, but perhaps useful to others).

Function IsWorkbookOpen(sFilePathName As String) As Variant
    '20160720 Update
    'IsWorkbookOpen is returned as {x,y}
    'X is True if file is open or False if it is closed
    'If it is a workbook and open, Y will be the username
    'If it is not a workbook and open, Y will be "Not Workbook"
    'If file does not exist X will be False, Y will be "Does Not Exist"
    'KEYWORDS: Is File Open, Is Workbook Open
    
    Dim fso As Object, bFE As Boolean
    Dim wbk As Workbook
    Dim sExt As String
    Dim iFilenum As Integer, lErrnum As Long
    Dim sFileNameExt As String
    Dim secAutomation As MsoAutomationSecurity
    secAutomation = Application.AutomationSecurity                          'Save ThisWorkbook security setting
    Application.AutomationSecurity = msoAutomationSecurityForceDisable      'Disable macros when opening file

    Set fso = CreateObject("Scripting.FileSystemObject")
    bFE = fso.FileExists(sFilePathName)
    sExt = fso.GetExtensionName(sFilePathName)
    sFileNameExt = fso.GetFilename(sFilePathName)
    
    If bFE Then
        'File Exists
        'Is it a workbook
        If InStr(".xls..xlsm..xlsx..xlsb..xla..xlam..", sExt) = 0 Then
            'Not a workbook
            On Error Resume Next    ' Turn error checking off.
            iFilenum = FreeFile()   ' Get a free file number.
            ' Attempt to open the file and lock it.
            Open sFilePathName For Input Lock Read As #iFilenum
            Close iFilenum          ' Close the file.
            lErrnum = Err           ' Save the error number that occurred.
            On Error GoTo 0         ' Turn error checking back on.
        
            ' Check to see which error occurred.
            Select Case lErrnum
            Case 0 ' File is NOT already open
                IsWorkbookOpen = Array(False, "Not Workbook")
            Case 70  'Permission Denied.
                IsWorkbookOpen = Array(True, "Not Workbook")
            Case Else   'Other error
                'Something else, Display Error
                Error lErrnum
            End Select
            GoTo End_Function
            
        End If
        
        'Is it a workbook opened in this instance of Excel?
        ThisWorkbook.Activate  'if another instance of Excel is active this check may fail
        For Each wbk In Application.Workbooks
            If wbk.Name = sFileNameExt Then
                IsWorkbookOpen = Array(True, Application.UserName)  'Workbook Open being used by ....
                GoTo End_Function
            End If
        Next
        
        'Check to see if workbook is already open in another instance of Excel...by trying to open it
        Set wbk = Workbooks.Open(sFilePathName)
        If wbk.ReadOnly Then
            IsWorkbookOpen = Array(True, wbk.WriteReservedBy)  'Workbook Open being used by ....
            Workbooks(sFileNameExt).Close SaveChanges:=False  'Close the read only copy we just opened
            'MsgBox wbk.WriteReservedBy & " currently using " & wbk.Name
            GoTo End_Function
        Else
            'Workbook was not open
            IsWorkbookOpen = Array(False, True)  'Not Open, is a workbook
            'Was opened by this procedure -- now close it
            Workbooks(sFileNameExt).Close SaveChanges:=False
        End If
        
    Else
    
        IsWorkbookOpen = Array(False, "Does Not Exist") 'File does not exist it cannot be open
        
    End If
    
End_Function:
    
    Set fso = Nothing
    Application.AutomationSecurity = secAutomation                          'Restore ThisWorkbook security setting
        
End Function