How do I check if a database is open

[JW61]

I need a way to check when the database is opened to see if it is already open by another user. If the user is the 'first' in then I want to run some update instructions.

I know I can check for the existence of the dbName.ldb file in the same directory but as soon as I open the database the file exists. So I have not been able to make this work from within the database I open.

Thanks,
JW

Every day I get up and look through the Forbes list of the richest people in America. If I'm not there, I go to work.

 

[SBerthold]

Public Sub ADOUserList(oConn As ADODB.Connection)
    Dim rs As ADODB.Recordset
    Set rs = oConn.OpenSchema(adSchemaProviderSpecific, , "{947bb102-5d43-11d1-bdbf-00c04fb92675}")
    Debug.Print rs.GetString
    rs.Close
End Sub

-You must pass an open connection object to this proceedure:
Call ADOUserList(MyConnectionObjectVariable)
or
Call ADOUserList(Form1.ADODC1.Recordset.ActiveConnection)

-The first value is the machine
-The second is the user name
-The third is a boolean (0=False; -1=True) and identifies if the user is still logged in or not.

-All values reset when all connections are closed.

-Multiple entires can exist for the same user and machine, even if only one Application is using the db, because an entry shows for each connection to the mdb.

 

[SBerthold]

Yes, and this is assumming you are using an Access/Jet database.

You can use the recordset object to get specific info back:

Public Sub ADOUserList(oConn As adodb.Connection)
    If Not (oConn Is Nothing) Then
        Dim rs As adodb.Recordset
        Set rs = oConn.OpenSchema(adSchemaProviderSpecific, , "{947bb102-5d43-11d1-bdbf-00c04fb92675}")
        Do Until rs.EOF
            If rs.Fields("CONNECTED").Value = True Then
                Debug.Print "User '" & Trim$(rs.Fields("LOGIN_NAME").Value) & "' " & _
                        "on machine '" & Trim$(rs.Fields("COMPUTER_NAME").Value) & "' " & _
                        "is currently logged on to: " & vbCr & _
                        rs.ActiveConnection.ConnectionString & vbCr & vbCr
            End If
            rs.MoveNext
        Loop
    End If
End Sub