Who has my database open?

Prior to Access 2007 the workgroup file could be used to determine who was logged on to the database. Since Access 2007+ does not use the workgroup file, here's a function that will return a recordset of the names of the files that are open and the people that have the file open.

Note that it is assumed that the database is split between a front-end and back-end and the back-end resides on a shared server. Or the front-end references an Access database (i.e. library database) that resides on a shared server. If you pass the name of the computer in which the back-end db resides and (optionally) pass the name of the back-end database and someone has it open, this routine should return the name of the back-end db and the name of the user that has it open.

What this function does is returns the Open File and Accessed By columns as seen when you open the Computer Management form via the Administrative Tools via the Control Panel (System Tools | Shared Folders | Open Files)

Should work with Windows XP, 2000 and 2003.

[code ]
Function GetOpenFiles(strComputerName As String, Optional strSearchForFile As String = "(ALL)") As ADODB.Recordset

Dim objConnection As Object
Dim colResources As Object
Dim objResource As Object
Dim strOutput As String

Dim rst As New ADODB.Recordset

rst.Fields.Append "OpenFile", adVarWChar, 255
rst.Fields.Append "User", adVarWChar, 20

rst.Open

Set objConnection = GetObject("WinNT://" & strComputerName & "/LanmanServer") 'You might need to check the registry for the name of the file service if not LanManServer
Set colResources = objConnection.Resources
On Error GoTo 7000

For Each objResource In colResources
If (strSearchForFile = "(ALL)") Or (InStr(objResource.Path, strSearchForFile) > 0) Then
rst.AddNew
rst.Fields(0).value = objResource.Path
rst.Fields(1).value = objResource.User
rst.Update
End If
Next

7000:
rst.Cancel

rst.Sort = rst.Fields(0).Name & " ASC"

Set GetOpenFiles = rst

End Function
[/code]

Here is an example of how to call the routine...
[code ]
Dim rst as New ADODB.Recordset
Set rst = GetOpenFiles("NameOfTheComputer")
(do whatever you want here)
rst.close
set rst = nothing
[/code]