Search code examples
ms-accessms-access-2003multi-user

How to see who is using my Access database over the network?


I actually have 2 questions:

1. How might I see who is using my Access database?

  • E.g: There is someone with an Access database opened and it created the .ldb file, I would like to see a list of who opened that database (it could be more than one person).

2. How might I see who is using a linked table?

  • E.g: I have 10 different Access databases, and all of them are using a same linked table. I would like to see who is using that linked table.

I don't even know if it's really possible, but I really appreciate your help!

For you information: The main problem is that lots of people use the same Access in the same network drive, so when I need to change it I have to kick them all out, but I never know who is actually using it.


Solution

  • Update: Rather than reading and parsing the .ldb/.lacdb file, a better approach would be to use the "User Roster" feature of the Access OLEDB provider as described in the Knowledge Base article

    https://support.microsoft.com/en-us/kb/285822

    and in the other SO question

    Get contents of laccdb file through VBA


    Original answer:

    I put together the following a while ago. It looked promising but then I discovered that computers are not immediately removed from the lock file when they disconnect. Instead, Jet/ACE seems to (internally) mark them as inactive: If ComputerA disconnects and then ComputerB connects, ComputerB overwrites ComputerA's entry in the lock file.

    Still, it does provide a list of sorts. I'm posting it here in case somebody can offer some suggestions for refinement.

    I created two tables in my back-end database:

    Table: [CurrentConnections]
    computerName  Text(255), Primary Key
    
    Table: [ConnectionLog]
    computerName  Text(255), Primary Key
    userName      Text(255)
    

    A VBA Module in my back-end database contained the following code to read (a copy of) the lock file and update the [CurrentConnections] table:

    Public Sub GetCurrentlyConnectedMachines()
        Dim cdb As DAO.Database, rst As DAO.Recordset
        Dim fso As Object  '' FileSystemObject
        Dim lck As Object  '' ADODB.Stream
        Dim lockFileSpec As String, lockFileExt As String, tempFileSpec As String
        Dim buffer() As Byte
    
        Set cdb = CurrentDb
        cdb.Execute "DELETE FROM CurrentConnections", dbFailOnError
        Set rst = cdb.OpenRecordset("SELECT computerName FROM CurrentConnections", dbOpenDynaset)
    
        lockFileSpec = Application.CurrentDb.Name
        If Right(lockFileSpec, 6) = ".accdb" Then
            lockFileExt = ".laccdb"
        Else
            lockFileExt = ".ldb"
        End If
        lockFileSpec = Left(lockFileSpec, InStrRev(lockFileSpec, ".", -1, vbBinaryCompare) - 1) & lockFileExt
    
        '' ADODB.Stream cannot open the lock file in-place, so copy it to %TEMP%
        Set fso = CreateObject("Scripting.FileSystemObject")  '' New FileSystemObject
        tempFileSpec = fso.GetSpecialFolder(2) & "\" & fso.GetTempName
        fso.CopyFile lockFileSpec, tempFileSpec, True
    
        Set lck = CreateObject("ADODB.Stream")  '' New ADODB.Stream
        lck.Type = 1  '' adTypeBinary
        lck.Open
        lck.LoadFromFile tempFileSpec
        Do While Not lck.EOS
            buffer = lck.Read(32)
            rst.AddNew
            rst!computerName = DecodeSZ(buffer)
            rst.Update
            buffer = lck.Read(32)  '' skip accessUserId, (almost) always "Admin"
        Loop
        lck.Close
        Set lck = Nothing
        rst.Close
        Set rst = Nothing
        Set cdb = Nothing
        fso.DeleteFile tempFileSpec
        Set fso = Nothing
    End Sub
    
    Private Function DecodeSZ(buf() As Byte) As String
        Dim b As Variant, rt As String
        rt = ""
        For Each b In buf
            If b = 0 Then
                Exit For  '' null terminates the string
            End If
            rt = rt & Chr(b)
        Next
        DecodeSZ = rt
    End Function
    

    The following code in the Main_Menu form of the front-end database updated the [ConnectionLog] table

    Private Sub Form_Load()
        Dim cdb As DAO.Database, rst As DAO.Recordset
        Dim wshNet As Object  '' WshNetwork
    
        Set wshNet = CreateObject("Wscript.Network")
        Set cdb = CurrentDb
        Set rst = cdb.OpenRecordset("SELECT * FROM ConnectionLog", dbOpenDynaset)
        rst.FindFirst "ComputerName=""" & wshNet.computerName & """"
        If rst.NoMatch Then
            rst.AddNew
            rst!computerName = wshNet.computerName
        Else
            rst.Edit
        End If
        rst!userName = wshNet.userName
        rst.Update
        Set wshNet = Nothing
    End Sub
    

    Finally, the following form in the back-end database listed [its best guess at] the current connections

    ShowActiveUsers

    It is a "continuous forms" form whose Record Source is

    SELECT CurrentConnections.computerName, ConnectionLog.userName 
    FROM CurrentConnections LEFT JOIN ConnectionLog 
        ON CurrentConnections.computerName = ConnectionLog.computerName 
    ORDER BY ConnectionLog.userName; 
    

    and the code-behind is simply

    Private Sub Form_Load()
        UpdateFormData
    End Sub
    
    Private Sub cmdRefresh_Click()
        UpdateFormData
    End Sub
    
    Private Sub UpdateFormData()
        GetCurrentlyConnectedMachines
        Me.Requery
    End Sub