I actually have 2 questions:
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.
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
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
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