none
What user has a file open? RRS feed

  • Question

  • I am using code from this forum to determine if a file is open before I try to open it to write to it.

    However, my users are complaining that a file is not open when I notify them the file is already open and I can't write to it.

    Is there code that will tell me what user has a file open if my system detects that it is already open? If I can determine who the system thinks has the file open perhaps I can get to the bottom of this issue and help my users get their job done and not get stuck at this point.

    I am trying to open and write to an excel file if that is any help.

    Thanks in advance for any help you can give.  --Fred

    Thursday, January 12, 2017 3:16 PM

All replies

  • If your file is an Excel file, try the code below in ThisWorkbook.

    Andreas.

    Option Explicit
    
    Private Sub Workbook_Open()
      Dim NFN As String, Username As String
      Dim ff As Integer
      NFN = GetNotifyFileName
      With ThisWorkbook
        If Not .ReadOnly Then
          'Create the notify file
          ff = FreeFile
          Open NFN For Binary As #ff
          Put #ff, , Application.Username
          Close #ff
        Else
          'Read the notify file
          If Dir(NFN) <> "" Then
            ff = FreeFile
            Open NFN For Binary As #ff
            Username = Space(LOF(ff))
            Get #ff, , Username
            Close #ff
            MsgBox "File is opened by " & Username
          End If
        End If
      End With
    End Sub
    
    Private Sub Workbook_BeforeClose(Cancel As Boolean)
      Dim NFN As String
      NFN = GetNotifyFileName
      With ThisWorkbook
        If Not .ReadOnly Then
          'Delete the notify file
          If Dir(NFN) <> "" Then Kill NFN
        End If
      End With
    End Sub
    
    Private Sub Workbook_AfterSave(ByVal Success As Boolean)
      'Create/update the notify file
      If Success Then Workbook_Open
    End Sub
    
    Private Function GetNotifyFileName() As String
      GetNotifyFileName = ThisWorkbook.Path & "\" & _
        Left$(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".")) & "xlnf"
    End Function
    

    Thursday, January 12, 2017 5:19 PM
  • Thanks, I will give this a try and let you know how it works out.

    -Fred

    Thursday, January 12, 2017 6:26 PM
  • Please do let us know.  I use a different approach.
    Thursday, January 12, 2017 9:04 PM
  • I use a different approach.

    Show it!

    It is always better for followers to have a choice between different code.
    And when one compare the codes, one can always learn something.

    Andreas.

    Friday, January 13, 2017 11:06 AM
  • I did this years ago and I need to find it, extract it, test it and document it.  I may have time next week.  If the solution provided works I didn't want to invest the time.

    • Edited by mogulman52 Friday, January 13, 2017 12:09 PM
    Friday, January 13, 2017 12:08 PM
  • I did this years ago and I need to find it, extract it, test it and document it.  I may have time next week.  If the solution provided works I didn't want to invest the time.

    ROFL. If you really think my code did not work you should hurry up... IMHO.

    Andreas.

    Friday, January 13, 2017 2:43 PM
  • I played with this a bit.  I have it working on Win 10 v1511 but v1607 it no longer works.  When Office opens a file Windows creates a hidden system file that has a ~ in front of it.  If you go to File Explorer Options and disable  Hide protected operating system files you'll see them.  If you open the file in Notepad you'll the see the user locking file.  The problem with v1607 is it no longer allows you to view the file.  In Win 7 it named the file based on its length.  I don't have Win 7 anymore so I can't test it.

    • Edited by mogulman52 Saturday, January 14, 2017 10:16 PM
    Saturday, January 14, 2017 10:12 PM
  • So far I am having trouble implementing this code.

    To begin with, I should have added this to my post:
    I am using Access 2003, though in tools>references I am using the Excel 14 Object Library and thus I can open and write to Excel 10 files.

    Also it is not clear that this function is complete.
    For example, there is no place in the code that refers to either of the functions 'Workbook_BeforeClose" or "Workbook_AfterSave"

    When I get to the method
    Application.Username
    I get the error:
    Compile error: Method or data member not found

    When I open the application in Access 2010 I also get same the compile error, so I don't know how this code is supposed to run.

    Any updates to this post greatly appreciated!  -Fred

    Wednesday, January 18, 2017 6:28 PM
  • To begin with, I should have added this to my post:

    I am using Access 2003, though in tools>references I am using the Excel 14 Object Library and thus I can open and write to Excel 10 files.

    Forget that, it's the wrong way.

    I'm not very familiar with Access, but I know that unfortunately there is no easy way to accomplish that.
    (I've never tried that in the past, so if anybody else in here has a solution: Please post!)

    Access supports AutoExec, this macro runs every time when you open a database.
    https://support.office.com/en-us/article/Create-a-macro-that-runs-when-you-open-a-database-98ba1508-dcc6-4e0f-9698-a4755e548124?ui=en-US&rs=en-US&ad=US&fromAR=1

    So the next questions are:

    a) What error comes up when another user has the same database already opened?
    b) And how can we detect that in the AutoExec macro?

    The final (but not necessarily necessary) question:
    Is there a way to run a macro when the database is closed?
    In that macro we can delete the notify file (clean up).

    Andreas.

    Thursday, January 19, 2017 11:25 AM
  • I finally figured out how to get around the problem with Win 10 v1607.  Just copy the lock file and read that.  Please note I don't have Win 7 anymore so I can't test it on Win 7.  Win 7 may rename lock file differently.  I commented some code that may work on Win 7.

    Option Explicit Option Base 0 Option Private Module Sub Test() Dim f As String Dim who As String f = "C:\temp\MyExcelFile.xlsx" If IsXlsFileOpen(f) Then who = WhoHasXlsOpen(f)

    Debug.Print who End If End Sub Function IsXlsFileOpen(xlsPath As String) As Boolean Dim fso As New Scripting.FileSystemObject Dim fileNum As Integer On Error GoTo ErrHandler If fso.FileExists(xlsPath) Then fileNum = FreeFile() Open xlsPath For Input Lock Read As fileNum On Error Resume Next Close #fileNum End If Exit Function ErrHandler: IsXlsFileOpen = True End Function Function WhoHasXlsOpen(xlsPath As String) As String Dim fso As New Scripting.FileSystemObject Dim fileNum As Integer Dim xlsName As String Dim ext As String Dim lockFile As String Dim path As String Dim path2 As String On Error GoTo ErrHandler fileNum = FreeFile() path = fso.GetParentFolderName(xlsPath) & "\" ext = fso.GetExtensionName(xlsPath) xlsName = fso.GetBaseName(xlsPath) ' ********** Maybe Windows 7 - Don't have it to test ' If Len(xlsName) > 6 Then ' If Len(xlsName) = 7 Then ' path = path & "~$" & _ ' Mid(xlsName, 2, Len(xlsName)) & "." & ext ' Else ' path = path & "~$" & _ ' Mid(xlsName, 3, Len(xlsName)) & "." & ext ' End If ' Else ' path = path & "~$" & xlsName & "." & ext ' End If ' ******** Windows 10 path = path & "~$" & xlsName & "." & ext path2 = path & "~$" & xlsName & "_copy." & ext fso.CopyFile path, path2 WhoHasXlsOpen = "" If fso.FileExists(path2) Then Open path2 For Input Shared As #fileNum Line Input #fileNum, lockFile Close #fileNum fso.DeleteFile path2 WhoHasXlsOpen = Trim(GetUserName(lockFile)) End If Exit Function ErrHandler: WhoHasXlsOpen = "" End Function Function GetUserName(textStr As String) As String ' Non username chars before and after username. Not always the same. Dim userName As String Dim c As String Dim i As Integer i = 1 c = Mid(textStr, 1, 1) While Not ((c >= "A" And c <= "Z") Or (c >= "a" And c <= "z") Or c = "." Or c = "-") i = i + 1 c = Mid(textStr, i, 1) Wend While ((c >= "A" And c <= "Z") Or (c >= "a" And c <= "z") Or c = "." Or c = "-" Or c = " ") And i < 20 userName = userName & c i = i + 1 c = Mid(textStr, i, 1) Wend GetUserName = userName End Function



    • Edited by mogulman52 Friday, January 20, 2017 1:31 PM
    Friday, January 20, 2017 1:22 PM