Which users have a database open.

[Sanibel]

If users are logging onto an Access database (2000) via an MDW file is it possible, within Access, to examine the LDB file to find out which user(s) are currently connected.

 

[Ed2020]

Yes, sort of. I have pasted some code below which will return the information you want. You do need to bear the following in mind though:

This will only be of use if each user has their own user ID in the Users group.

The MDW file isn't updates as soon as somebody closes the system.

Public Sub LogUserRoster()
    On Error GoTo TrapErr

    Dim cnn As New ADODB.Connection
    Dim rstConnections As New ADODB.Recordset
    Dim ThisDB As DAO.Database
    Dim rstLog As DAO.Recordset

    cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=Y:\Shared\NGSRV51H003\TeamData\BSS Offline Systems\Status LIVE\D296 - MRUN Database\MRUN Workflow Backend v1.mdb;User ID=;Password=;"

    ' The user roster is exposed as a provider-specific schema rowset
    ' in the Jet 4.0 OLE DB provider.  You have to use a GUID to
    ' reference the schema, as provider-specific schemas are not
    ' listed in ADO's type library for schema rowsets

    Set rstConnections = cnn.OpenSchema(adSchemaProviderSpecific, _
    , "{947bb102-5d43-11d1-bdbf-00c04fb92675}")

    'Output the list of all users in the current database.
    Set ThisDB = CurrentDb()
    Set rstLog = ThisDB.OpenRecordset("tblLog", dbOpenDynaset)

    While Not rstConnections.EOF
        rstLog.AddNew
            rstLog!ScanTime = Now()
            rstLog!ComputerName = Trim(rstConnections!COMPUTER_NAME)
            rstLog!UserName = Trim(rstConnections!LOGIN_NAME)
            rstLog!CONNECTED = rstConnections!CONNECTED
            rstLog!SuspectState = rstConnections!SUSPECT_STATE
        rstLog.Update
        rstConnections.MoveNext
    Wend
    
    rstLog.Close
    ThisDB.Close
    rstConnections.Close
    cnn.Close
    
    Set rstLog = Nothing
    Set ThisDB = Nothing
    Set rstConnections = Nothing
    Set cnn = Nothing
    
ExitHere:
    Exit Sub
    
TrapErr:
    Resume ExitHere
End Sub

This code has been taken from the MS site (can't remember the URL - sorry).

You may want to do something about my lazy-man's error trapping as well!

Ed Metcalfe.

Please do not feed the trolls.....

 

[scottie2605]

hi

why dont you just do an update qry when someone opens your database on the startup form. Make it add username to a table and set checkbox field to true to say they are in it. then on the unload event do another update qry to change checkbox field to false

 

[Remou]

Some code (Microsoft, I think)
You can get the DLL here:

http://support.microsoft.com/kb/176670

      Declare Function LDBUser_GetUsers Lib "MSLDBUSR.DLL" _
      (lpszUserBuffer() As String, ByVal lpszFilename As String, _
      ByVal nOptions As Long) As Integer

      Public Function GetUsers(Optional StrDbPath As String)

         ReDim lpszUserBuffer(1) As String
         Dim intLooper As Integer
         Dim Cusers As Long
         Dim strMsgBox As String

         On Error GoTo Err_GetUsers

         ' Check to see if a database path was passed
         ' to the function. If the argument was not used,
         ' assume that we're to investigate the .ldb
         ' of the current database.
         If IsMissing(StrDbPath) Or StrDbPath = "" Then
              StrDbPath = CurrentDb.Name
         End If

         ' Set Cusers to the number of computers currently connected
         ' to the database. Insert computer information into the
         ' lpszUserBuffer array.

         ' Arguments of LdbUser_Get Users:
         ' 1 =   All users who have logged in since the LDB file was
         ' created
         ' 2 =   Only users who are currently logged in
         ' 4 =   Only users who are causing the database file to be
         ' corrupted
         ' 8 =   Just return the count of users

         Cusers = LDBUser_GetUsers(lpszUserBuffer(), StrDbPath, 2)

         ' Print possible errors returned by the function.
         Select Case Cusers
              Case -1
                   strMsgBox = "Can't open the LDB file"
              Case -2
                   strMsgBox = "No user connected"
              Case -3
                   strMsgBox = "Can't Create an Array"
              Case -4
                   strMsgBox = "Can't redimension array"
              Case -5
                   strMsgBox = "Invalid argument passed"
              Case -6
                   strMsgBox = "Memory allocation error"
              Case -7
                   strMsgBox = "Bad index"
              Case -8
                   strMsgBox = "Out of memory"
              Case -9
                   strMsgBox = "Invalid Argument"
              Case -10
                   strMsgBox = "LDB is suspected as corrupted"
              Case -11
                   strMsgBox = "Invalid argument"
              Case -12
                   strMsgBox = "Unable to read MDB file"
              Case -13
                   strMsgBox = "Can't open the MDB file"
              Case -14
                   strMsgBox = "Can't find the LDB file"
         End Select

         If Not IsEmpty(strMsgBox) And strMsgBox <> "" Then
              MsgBox strMsgBox, vbCritical, "Error"
              Exit Function
         End If

         ' Print computer names to Debug window.
         For intLooper = 0 To Cusers - 1
              Debug.Print "User"; intLooper + 1; ":"; _
              lpszUserBuffer(intLooper)
         Next

Exit_GetUsers:
         Exit Function
Err_GetUsers:
         MsgBox Err.Description
         Resume Exit_GetUsers

End Function