Identify who is using DB

[CEH]

Glanced through the search but haven't found an answer yet.... I have a DB that is split, front end on stations, back end on server. No real need for security on this, so no coding done for that. Is there still a way I can see who is currently using the DB?

 

[RuralGuy]

Have a look at this link.

 

[CEH]

Thanks RG. I'll give it a shot.

 

[CEH]

OK RG... Found one I like but stumped trying to bring the results to a form.

Sub ShowUserRosterMultipleUsers()
    Dim cn As New ADODB.Connection
    Dim cn2 As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim i, j As Long

    cn.Provider = "Microsoft.Jet.OLEDB.4.0"
    cn.Open "Data Source=c:\Northwind.mdb"

    cn2.Open "Provider=Microsoft.Jet.OLEDB.4.0;" _
    & "Data Source=c:\Northwind.mdb"

    ' The user roster is exposed as a provider-specific schema rowset
    ' in the Jet 4 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 rs = cn.OpenSchema(adSchemaProviderSpecific, _
    , "{947bb102-5d43-11d1-bdbf-00c04fb92675}")

    'Output the list of all users in the current database.

    Debug.Print rs.Fields(0).Name, "", rs.Fields(1).Name, _
    "", rs.Fields(2).Name, rs.Fields(3).Name

    While Not rs.EOF
        Debug.Print rs.Fields(0), rs.Fields(1), _
        rs.Fields(2), rs.Fields(3)
        rs.MoveNext
    Wend

End Sub

This one from Microsoft.... After I set the path to the backend... no problem... type ?ShowUserRosterMultipleUsers in the intermediate window and get the results. But...... I do not want to open the editor when I need to do this... want to open a form....
Now I have tried using unbound textboxes... listboxes... so on... putting =ShowUserRosterMultipleUsers() for the control source... error. This doesn't seem like it should be this hard...... I just want to pull the info from the code instead of a table or query...... and display it on a form!
Point me in the right direction here.... Can't find a thing to go off of on my searches.
Thanks

 

[RuralGuy]

You should be able to populate a ListBox with that RecordSet (rs). Comment out the Debug.Print lines.

 

[CEH]

well, if I comment out the "Debug.Print" lines it doesn't return a value. That leads to a question on this code... Why is it a "Sub" and not a "Function"? And also does the line "Dim i, j As Long" have any purpose?

 

[RuralGuy]

The code you like was designed to print to the immediate window. You need to modify it and incorporate it in your form and use the RecordSet it created to populate a ListBox. As listed, the i and j Long Integers are not being used.

 

[CEH]

OK. I'm about to give up before I go nuts.... I placed the procedure on the form. The unbound listbox record source is now ShowRoster() (I changed the name) It opens... No errors.... but nothing is in the listbox... Row source type is Value list. This looks like it should be a simple thing..... And I can't find ANYTHING in any post or examples that works!

 

[RuralGuy]

Hi Curtis,
Did you explore the other url's on the link I gave you? http://www.mvps.org/access/modules/mdl0055.htm

 

[CEH]

Well, Yes........ But they all seemed to lead back to the original...... Here's what I finally came up with........

 Function ShowRoster() As String

Dim cn As New ADODB.Connection
Dim cn2 As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim strUsers As String

   cn.Provider = "Microsoft.Jet.OLEDB.4.0"
   cn.Open "Data Source=F:\WBMApps2\NewJobsApp5.be.mdb"

   cn2.Open "Provider=Microsoft.Jet.OLEDB.4.0;" _
   & "Data Source=F:\WBMApps2\NewJobsApp5.be.mdb"

   ' The user roster is exposed as a provider-specific schema rowset
   ' in the Jet 4 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 rs = cn.OpenSchema(adSchemaProviderSpecific, _
   , "{947bb102-5d43-11d1-bdbf-00c04fb92675}")

   'Create a list of all users in the current database.

   Do While Not rs.EOF
       strUsers = strUsers & _
         (rs.Fields(0).Name) & " " & (rs.Fields(0))
         
rs.MoveNext
   Loop



   ShowRoster = strUsers

End Function

But there is a problem....... It is only returning MY computer name and not others logged on.

 

[Colby]

If you are still in need...

I have a fe/be setup and this works fine.
When the fe opens on the users desktop they are signed in user their network id. By 'signed in' I mean I add them to a table along with some other info for tracking.
My be has a link to this table so I can query.
I have a form with a command button to display the records. Below you will find my code.

Private Sub Command5_Click()
sSQL = "SELECT [tbl_NET-CurrentUsers].[USER], [tbl-ValidUsers].[USER] AS UserName, [tbl-ValidUsers].PHONE, " & _
"[tbl-ValidUsers].LOCATION, [tbl_NET-CurrentUsers].[Time-In], [tbl-ValidUsers].LEVEL " & _
"FROM [tbl-ValidUsers] RIGHT JOIN [tbl_NET-CurrentUsers] ON [tbl-ValidUsers].X_NUMBER = [tbl_NET-CurrentUsers].USER " & _
"ORDER BY [tbl-ValidUsers].LEVEL DESC"

Set qdTemp = CurrentDb().OpenRecordset(sSQL)

If qdTemp.RecordCount = 0 Then
Beep
MsgBox "No Current Users.", vbInformation, "No Users"
strValues = Null
Else

Do Until qdTemp.EOF
'strValues = qdTemp.Fields(0) & " - " & qdTemp.Fields(1) & ";" & strValues 'displays the agents name
strValues = qdTemp.Fields(0) & " - " & qdTemp.Fields(1) & " - " & qdTemp.Fields(2) & " - " & qdTemp.Fields(3) & " - " & qdTemp.Fields(4) & " - " & qdTemp.Fields(5) & ";" & strValues
qdTemp.MoveNext
Loop
Forms("Form1")![lstShowUser].RowSourceType = "Value List"
Forms("Form1")![lstShowUser].RowSource = strValues

End If

End Sub

Hope this helps - please post back and let me now.

 

[CEH]

I may have to end up going with your method or another like it. Someone has told me with the current one I am using I have applied Access User-Level Security..... All I'm looking for is a return of the computer names... Don't need or want a sign in. But..................

 

[Colby]

but....

my users dont actually sign in; I just pull their user name by
Function fOSUserName() As String

Dim lngLen As Long, lngX As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)

If lngX <> 0 Then

'Get the user name from the computer that opened the DB

fOSUserName = UCase(Left$(strUserName, lngLen - 1))
Else

'In case there is no user name

fOSUserName = ""
End If

End Function


this will not get the computer name; however, the same structure should be able to be applied.

 

[realvilla]

Here is another version of the same thing using the MSgBox function.

Sub Userlist()
Const dbSecUserRosterGuid = "{947bb102-5d43-11d1-bdbf-00c04fb92675}"
Dim rs As ADODB.Recordset, sList As String
Dim con As ADODB.Connection

Set con = CurrentProject.Connection
Set rs = con.OpenSchema(adSchemaProviderSpecific, , dbSecUserRosterGuid)
While Not rs.EOF
sList = sList & Left(rs.fields(1), Len(RTrim(rs.fields(1))) - 1) & vbCr
rs.MoveNext
Wend
MsgBox sList