Why Am I Getting Runtime Error 3251?

[andigirlsc]

I found some VBA code posted by ADezii on this site that will generate a list of users who are currently logged into my database. I pasted this code into the VBA window of a new blank form, following the instructions from the developer. The problem is I am getting a compile error whenever I run the code. I am using the Front End of an Access 2010 database. I also have access to the Back End as I have developed the DB myself. The code is listed as Private Function GenerateUserList() and is called from the Open Event in the form and is set to refresh every ten seconds.

What I have tried:
I tried pasting this code into a module and calling it in the form, but I the same line of code triggers an error. I researched and found similar posts, but not one that showed the same error I received. Any help is greatly appreciated!

Error Message:
Runtime error 3251. Object or provider is not capable of performing requested operation.

Code That Triggers Error:
Set rst = cnn.OpenSchema(Schema:=adSchemaProviderSpecific, SchemaID:=conUsers)

Original VBA Code:
The code that triggers the error when I compile is in blue, bold print.

Code:

 Private Function GenerateUserList()
'The User List Schema information requires this magic number. For anyone
'who may be interested, this number is called a GUID or Globally Unique
'Identifier - sorry for digressing
Const conUsers = "{947bb102-5d43-11d1-bdbf-00c04fb92675}"
 
Dim cnn As ADODB.Connection, fld As ADODB.Field, strUser As String
Dim rst As ADODB.Recordset, intUser As Integer, varValue As Variant
 
Set cnn = CurrentProject.Connection
Set rst = cnn.OpenSchema(Schema:=adSchemaProviderSpecific, SchemaID:=conUsers)
 
'Set List Box Heading
strUser = "Computer;UserName;Connected?;Suspect?"
 
With rst    'fills Recordset (rst) with User List data
  Do Until .EOF
    intUser = intUser + 1
      For Each fld In .Fields
        varValue = fld.Value
          'Some of the return values are Null-Terminated Strings, if
          'so strip them off
          If InStr(varValue, vbNullChar) > 0 Then
            varValue = Left(varValue, InStr(varValue, vbNullChar) - 1)
          End If
          strUser = strUser & ";" & varValue
      Next
        .MoveNext
  Loop
End With
 
Me!txtTotalNumOfUsers = intUser        'Total # of Users
 
'Set up List Box Parameters
Me!lstUsers.ColumnCount = 4
Me!lstUsers.RowSourceType = "Value List"
Me!lstUsers.ColumnHeads = False
  lstUsers.RowSource = strUser       'populate the List Box
 
'Routine cleanup chores
Set fld = Nothing
Set rst = Nothing
Set cnn = Nothing
 End Function
 
Private Sub Form_Open(Cancel As Integer)
  Call GenerateUserList
End Sub
 
 Private Sub Form_Timer()
  Call GenerateUserList
End Sub 

[twinnyfo]

andigirlsc,

I use a slightly different version of this code:

Option Compare Database
Option Explicit
 
'Set some Constants and Public Variables
Private Const dbLockFile As String = "\\NetworkLocation\NetworkFolder\DatabaseName.laccdb"
 
Private Sub CurrentUsers()
On Error GoTo EH
    Dim strCurrentUsers As String
    Dim strUserString   As String
    Dim intFileNumber   As Integer
    Dim LineofText      As String
    Dim intPointer      As Integer
    intFileNumber = FreeFile
    If fIsFileDir(dbLockFile) Then
        Open dbLockFile For Input As #intFileNumber
        Me.txtLockFileContents = ""
        strCurrentUsers = ""
        strUserString = ""
        Do While Not EOF(intFileNumber)
            ' Read each line of the text file into a single string variable.
            Line Input #intFileNumber, LineofText
            While Len(LineofText) > 0 And Len(LineofText) >= 62
                intPointer = 1
                Do While Mid(LineofText, intPointer, 1) <> " "
                    intPointer = intPointer + 1
                Loop
                strUserString = Left(LineofText, intPointer - 1)
                strCurrentUsers = IIf(Len(strCurrentUsers) = 0, strUserString, _
                    strCurrentUsers & vbCrLf & strUserString)
                LineofText = Right(LineofText, Nz(Len(LineofText) - 62, 0))
            Wend
        Loop
        Close #intFileNumber
        Me.txtLockFileContents = strCurrentUsers
    Else
        Me.txtLockFileContents = "No Current Users"
    End If
    Exit Sub
EH:
    MsgBox "There was an error finding all Current Users.  " & _
        "Please contact your Database Administrator.", vbCritical, "Error!"
    Exit Sub
End Sub
Private Function fIsFileDir(strPath As String, Optional lngType As Long) As Integer
On Error Resume Next
    'Check to see if file exists
    fIsFileDir = Len(Dir(strPath, lngType)) > 0
End Function

This will return the Computer Name of the user that is logged into the DB. With another table containing Computer Names and Users, you can easily find the person who is logged in.

Hope this hepps!

[sunnyk2057]

Hi I am facing the same problem . Can you please help me out

Thanks

@twinnyfo I tried the code shared by you but its not returning anything

 Sub CurrentUsers()
            Dim strCurrentUsers As String
            Dim strUserString   As String
            Dim intFileNumber   As Integer
            Dim LineofText      As String
            Dim intPointer      As Integer
            Dim dbLockFile As String
            intFileNumber = FreeFile
            dbLockFile = CurrentProject.Path & "\" & CurrentDb.Name
            Open dbLockFile For Input As #intFileNumber
 
            strCurrentUsers = ""
            strUserString = ""
            Do While Not EOF(intFileNumber)
                ' Read each line of the text file into a single string variable.
                Line Input #intFileNumber, LineofText
                While Len(LineofText) > 0 And Len(LineofText) >= 62
                    intPointer = 1
                    Do While Mid(LineofText, intPointer, 1) <> " "
                        intPointer = intPointer + 1
                    Loop
                    strUserString = Left(LineofText, intPointer - 1)
                    strCurrentUsers = IIf(Len(strCurrentUsers) = 0, strUserString, _
                        strCurrentUsers & vbCrLf & strUserString)
                    LineofText = Right(LineofText, Nz(Len(LineofText) - 62, 0))
                Wend
            Loop
            Close #intFileNumber
            MsgBox strCurrentUsers
    End Sub

code i am trying to use