Using JetUserRoster from Access database

Posted on 2004-10-06
Medium Priority
Last Modified: 2008-03-03
I'm trying to get a list of users who are currently logged into a database from that current database.  I'm developing an Administrator tools menu that displays who is currently logged in to the database.  I've developed a similar application with VB using the code below:

Public Sub GetCurrentUsers(strConnection As String)

On Error GoTo err_trap:

    Dim cn As New ADODB.Connection
    Dim rstUserList As New ADODB.Recordset
    Dim LineItem As ListItem
    Dim i As Integer
    i = 0
    cn.Provider = "Microsoft.Jet.OLEDB.4.0;"
    'cn.Properties("Jet OLEDB:System database") = strMDWPath
    cn.Open strConnection
    Set rstUserList = cn.OpenSchema(adSchemaProviderSpecific, _
    , "{947bb102-5d43-11d1-bdbf-00c04fb92675}")
    With Me.ctlListView.ListItems
        Do Until rstUserList.EOF
            Set LineItem = .Add(, , "")
            LineItem.SubItems(1) = IIf(Len(rstUserList.Fields(0)) > 0, rstUserList.Fields(0), "")
            LineItem.SubItems(2) = IIf(Len(rstUserList.Fields(1)) > 0, rstUserList.Fields(1), "")
            LineItem.SubItems(4) = IIf(Len(rstUserList.Fields(2)) > 0, rstUserList.Fields(2), "")
            LineItem.SubItems(5) = IIf(Len(rstUserList.Fields(3)) > 0, rstUserList.Fields(3), "False")
        Set rstUserList = Nothing
        Set cn = Nothing
    End With
    Call SetupCurrentUserList

    DoCmd.Hourglass False
    Exit Sub
    MsgBox "Error Number: " & Err.Number & vbCr & "Description: " & Err.Description, _
            vbCritical, "ERROR"
    Resume Exit_Sub
End Sub

Public Sub SetupCurrentUserList()
Dim LineItem As ListItem

'Set Status
If Me.ctlListView.ListItems.Count = 1 Then
    Me.txtStatus = "No users connected other than this program."
    Me.txtStatus = Me.ctlListView.ListItems.Count & _
        " users connected (including the connection maintainted by this program)."
End If

'Set Icons
With Me.ctlListView
    For Each LineItem In .ListItems
        If LineItem.SubItems(5) = "True" Then
            LineItem.SmallIcon = "suspect"
            If CurrentMachineName = LineItem.SubItems(1) Then
                LineItem.SmallIcon = "comp"
                If LineItem.SubItems(4) = "True" Then
                    LineItem.SmallIcon = "network"
                    LineItem.SmallIcon = "network_closed"
                End If
            End If
        End If
End With

End Sub

When I want to populate the user list I call GetCurrentUsers(currentdb.name).  It gives me the following error:

Error Number: -2147467259
Error Description: The database has been placed in a state by user 'Admin' on machine 'HPHome' that prevents it from being opened or locked.

I know the problem is that I am trying to use JetUserRoster to open the datatabase that I currently in.  

Any suggestions on how I can modify the code above to get the user list using JetUserRoster of the database that I am currently in??

Any help would be greatly appreciated...
Question by:jg0069_2002

Author Comment

ID: 12246106
I think I've figured it out, so I guess I need to withdraw the question.  What I did was the following:

In the GetCurrentUsers subroutine, I replaced:

    cn.Provider = "Microsoft.Jet.OLEDB.4.0;"
    'cn.Properties("Jet OLEDB:System database") = strMDWPath
    cn.Open strConnection

with Set cn = CurrentProject.Connection

and everything worked as planned...
LVL 85
ID: 12247780
Yes, post a question in Communit Support to do delete the question (with a pointer back to this question)

Accepted Solution

modulo earned 0 total points
ID: 12898237
PAQed with points refunded (70)

Community Support Moderator

Featured Post

Get quick recovery of individual SharePoint items

Free tool – Veeam Explorer for Microsoft SharePoint, enables fast, easy restores of SharePoint sites, documents, libraries and lists — all with no agents to manage and no additional licenses to buy.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

The Windows Phone Theme Colours is a tight, powerful, and well balanced palette. This tiny Access application makes it a snap to select and pick a value. And it doubles as an intro to implementing WithEvents, one of Access' hidden gems.
Windows Explorer lets you open cabinet (cab) files like any other folder. In VBA you can easily handle normal files and folders, but opening and indeed creating cabinet files takes a lot more - and that's you'll find here.
Visualize your data even better in Access queries. Given a date and a value, this lesson shows how to compare that value with the previous value, calculate the difference, and display a circle if the value is the same, an up triangle if it increased…
Look below the covers at a subform control , and the form that is inside it. Explore properties and see how easy it is to aggregate, get statistics, and synchronize results for your data. A Microsoft Access subform is used to show relevant calcul…
Suggested Courses

755 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question