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
2 3565
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!
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
Sign in to post your reply or Sign up for a free account.
Similar topics
by: Bill Patel |
last post by:
I am getting Runtime error on line 50. Please Help.
Thank You
Bill
1 <%@ Page Language="VB" %>
2 <%@ import Namespace="System.Data" %>
3 <%@ import Namespace="System.Data.SqlClient"...
|
by: Pat |
last post by:
In my Web.config i have :-
<customErrors mode="On" defaultRedirect="genericerror.htm">
<error statusCode="404" redirect="pagenotfound.aspx"/>
</customErrors
to get page not found error but...
|
by: ydprasad |
last post by:
I am trying to convert the code that was written in VB using DAO to ADO.
But when i tried to do following getting an error '3251'.
*************code**************************
Dim cn As New...
|
by: akoymakoy |
last post by:
Run time error 3251 Current Recordset does not support updating, this may be a limitation of the provider, or of the selected Locktype
This is my simple program that will split the entries that...
|
by: ruvi |
last post by:
I am getting runtime error 3021 - Either EOF or BOF is true or the current record has been deleted.....
I have 2 combo boxes in a form- One for the client and the other for the project.
When the...
|
by: Lauren Dobson |
last post by:
This database was working days ago, outputting a vocabulary list into a word document. Any idea why I'm getting runtime error 3010? I just switched from Windows XP to Windows 7 but I'm still using...
|
by: creation |
last post by:
$b= 1;
while($b)
{
$a = <>;
if($a eq 42)
break;
else
{
print $a;
}
|
by: mishika |
last post by:
Q: getting runtime error 52 bas file name or number
D:Public Function gf_ChkMkDir(iDirPath As String, iDirName As String) As Boolean
Dim MyPath As String
gf_ChkMkDir = False
MyPath =...
|
by: Vasago |
last post by:
Bookings ID is number
ID is autonumber
Error says:
Run-Time error '2471':
The expression you entered as a query parameter produced this error: ''
If DCount("", "Access Click log", " = " &...
|
by: emmanuelkatto |
last post by:
Hi All, I am Emmanuel katto from Uganda. I want to ask what challenges you've faced while migrating a website to cloud.
Please let me know.
Thanks!
Emmanuel
|
by: BarryA |
last post by:
What are the essential steps and strategies outlined in the Data Structures and Algorithms (DSA) roadmap for aspiring data scientists? How can individuals effectively utilize this roadmap to progress...
|
by: nemocccc |
last post by:
hello, everyone, I want to develop a software for my android phone for daily needs, any suggestions?
|
by: Hystou |
last post by:
There are some requirements for setting up RAID:
1. The motherboard and BIOS support RAID configuration.
2. The motherboard has 2 or more available SATA protocol SSD/HDD slots (including MSATA, M.2...
|
by: jinu1996 |
last post by:
In today's digital age, having a compelling online presence is paramount for businesses aiming to thrive in a competitive landscape. At the heart of this digital strategy lies an intricately woven...
|
by: Hystou |
last post by:
Overview:
Windows 11 and 10 have less user interface control over operating system update behaviour than previous versions of Windows. In Windows 11 and 10, there is no way to turn off the Windows...
|
by: tracyyun |
last post by:
Dear forum friends,
With the development of smart home technology, a variety of wireless communication protocols have appeared on the market, such as Zigbee, Z-Wave, Wi-Fi, Bluetooth, etc. Each...
|
by: agi2029 |
last post by:
Let's talk about the concept of autonomous AI software engineers and no-code agents. These AIs are designed to manage the entire lifecycle of a software development project—planning, coding, testing,...
|
by: conductexam |
last post by:
I have .net C# application in which I am extracting data from word file and save it in database particularly. To store word all data as it is I am converting the whole word file firstly in HTML and...
| |