Matti VM
Matti VM

Reputation: 1214

How to get name of user who has (Excel) file open on server, using Access VBA?

There are multiple Excel files on a server (or network shared storage location).

I have an Access document that needs access to these Excel files to execute a certain function.

When one of these files is open I can not execute my VBA function.

I check if someone is using the file. This is in the code below.

Is it is possible to also find out who is using a file. I would notify them to close the file(s).

Some of the things I tried (these are not all, but I can’t find a few methods anymore that I tried too): https://chandoo.org/forum/threads/return-user-name-who-has-file-open.31447/ https://www.ozgrid.com/forum/forum/help-forums/excel-general/87346-vba-code-to-determine-who-has-file-open

In the last one they get the owner of the file and that is not the same as the one that is using the file at that moment. I tried it, but even then I sometimes get a username, but the username of the one that created the file and sometimes I get a SID (Security Identifier?).

Code to find out if the file is in use. This does not include anything to see who is using the file.

Sub TestFileOpened()
    Dim filesArray As Variant
    filesArray = Array("Map1.xlsx", "Map2.xlsx")
    Dim fileLocation As String
    fileLocation = "\\DESKTOP-NETWORK\SharedFolder\NetwerkTest\"
    Dim message As String
    
    For Each file In filesArray
        If IsFileOpen(fileLocation & file) Then
            message = message & vbNewLine & "File '" & file & "' is open!"
        'Else
        '    message = message & vbNewLine & "File '" & file & "' is closed!"
        End If
    Next file
    
    MsgBox message
    
End Sub

Function to check if the file is in use:

Function IsFileOpen(filename As String)
    Dim filenum As Integer, errnum As Integer
    
    On Error Resume Next
    filenum = FreeFile()
    
    Open filename For Input Lock Read As #filenum
    Close filenum
    errnum = Err
    On Error GoTo 0
    
    Select Case errnum
        Case 0
            IsFileOpen = False
        Case 70
            IsFileOpen = True
        Case Else
            Error errnum
    End Select
End Function

Access and Excel are able to do exactly that when you try to manually open the file. Superuser post: https://superuser.com/questions/845084/how-to-get-excel-to-show-username-of-person-that-has-file-open

Upvotes: 4

Views: 6342

Answers (2)

Simon
Simon

Reputation: 21

This is ingenious - but very slightly risky - but only because the subroutine modifies its input parameter! I've tarted it up a bit here, and also added a check for if the file is not in use by anyone! I've also enhanced it to make it more readable. This also fixes a bug affecting 13-character long login names (13 = x0d = vbCr!).

Function InUseBy(FileName As String) As String
'
' This fixes:
' a. 13 character long usernames
' b. does not modify the supplied FileName value
'
' Note: not tested on Excel-sharable workbooks
'
    Dim WorkFile As String
    Dim TempFile As String
    Dim iptr As Integer
    Dim buffer As String
    Dim fso As Object
    Dim NameLength As Integer
    Dim rezult As Variant
'
' Invent a temporary workfile name
'
    WorkFile = Environ("TEMP") & "\Workfile" & CStr(Int(Rnd * 1000))
'
' Derive the Excel temporary file that will exist if it's open for update
'
    iptr = InStrRev(FileName, "\")
    If iptr > 0 Then
        TempFile = Mid(FileName, 1, iptr) & "~$" & Mid(FileName, 1 + iptr)
    Else
        TempFile = "~$" & FileName
    End If
'
' If the temporary file does not exist then the supplied file is either not open, or it's open read-only
'
    If Dir(TempFile, vbHidden + vbSystem) = "" Then  
'
' - it's not open, or open read-only
'
       InUseBy = "No-one, or open read-only"
'
' Else copy the contents of the temporary file to the workfile
'
    Else
       Set fso = CreateObject("Scripting.FileSystemObject")
       fso.CopyFile TempFile, WorkFile
'
' - try to open the workfile
'
       On Error Resume Next
       Set ts = fso.GetFile(WorkFile).OpenAsTextStream(1, -2)
       rezult = Err.Number
       On Error GoTo 0
'
' --  if successful then extract the user's username
'     (the INPUT approach fails if username is length 13, because it sees x0D as a carriage-return character!)
'     (record format is Nusername... where N is the length of username (max 255))
'
       If rezult = 0 Then
          buffer = ts.readall
          ts.Close
          Set ts = Nothing
'
          NameLength = Asc(buffer)
          InUseBy = Mid(buffer, 2, NameLength)
'
' -- else return an error
'
       Else
          InUseBy = "Error " & rezult & " reading temporary file"
       End If
'
' - delete the workfile
'
       fso.Deletefile WorkFile
       Set fso = Nothing
    End If
End Function

Upvotes: 2

Luuk
Luuk

Reputation: 14899

Ok, i am not good in writing descent macro's, so modify code to suit your own needs!

This one should give the name of the user who has currently opened an Excel-sheet:

Sub InUse(filename As String)
    Dim f
    Dim i
    Dim x
    Dim inUseBy
    Dim tempfile
    tempfile = Environ("TEMP") + "\tempfile" + CStr(Int(Rnd * 1000))
    
    f = FreeFile
    i = InStrRev(filename, "\")
    If (i > 0) Then
        filename = Mid(filename, 1, i) + "~$" + Mid(filename, 1 + i)
    Else
        filename = "~$" + filename
    End If
    
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    fso.CopyFile filename, tempfile
    
    Open tempfile For Binary Access Read As #f
    Input #f, x
    Close (f)
    inUseBy = Mid(x, 2, Asc(x))
    fso.Deletefile tempfile
    Set fso = Nothing

    MsgBox "InUse by: " + inUseBy, vbOKOnly, "InUse"
    
End Sub

Example use:

InUse("T:\Book1.xlsx")

Things to note:

  1. This should be used when opening of a sheet fails (because of bein in-use)
  2. I did not find any documentation about this being the 'valid' way to do this.
  3. I do not know if this also works with shared excel sheets

Upvotes: 3

Related Questions