Identify User (1 Viewer)

Phredd

Registered User.
Local time
Today, 17:03
Joined
May 28, 2002
Messages
34
Hi Guys,

I am trying to determine which user currently has a database open in my company to allow me to ask them to close it for maintenance.

I am a little (Lot) out of my depth with this level of coding, but have stolen this code from another site on recommendation.

While I have no errors, I have no idea where/wehat/how to get the resulting user information. The macro appears to run great (No errors) but nothing obvious tells me the user either..

Thx
------------------------------------------------

Option Compare Database
Private Declare Function apiGetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long


Private Sub Form_Load()
Dim t As DAO.TableDef, texists as Boolean
texists = False
For Each t In CurrentDb.TableDefs
If t.Name = "users_logged_in" Then
texists = True
Exit For
End If
Next t
Set t = Nothing
If Not texists Then
create_table
End If
CurrentDb.Execute "INSERT INTO users_logged_in ( [USER], TIME_IN ) VALUES('" & fOSUserName & "', '" & Now() & "')"
Me.TimerInterval = 100
End Sub
Private Sub create_table()
Dim t As DAO.TableDef, db As DAO.Database, f1 As DAO.Field, f2 As DAO.Field

Set db = CurrentDb: Set t = New DAO.TableDef: Set f1 = New DAO.Field: Set f2 = New DAO.Field

t.Name = "users_logged_in"

f1.Name = "USER"
f1.Type = dbText

f2.Name = "TIME_IN"
f2.Type = dbDate

t.Fields.Append f1
t.Fields.Append f2

db.TableDefs.Append t

Set f1 = Nothing: Set f2 = Nothing: Set t = Nothing: Set db = Nothing

Application.SetHiddenAttribute acTable, "users_logged_in", True
Application.RefreshDatabaseWindow

End Sub
Private Function fOSUserName() As String 'Returns the network login name

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
fOSUserName = Left$(strUserName, lngLen - 1)
Else
fOSUserName = vbNullString
End If
End Function
Private Sub Form_Close()
CurrentDb.Execute "DELETE * FROM users_logged_in WHERE USER = '" & fOSUserName & "'"
End Sub

Private Sub Form_Timer()
Me.Visible = False
Me.TimerInterval = 0
End Sub
 

pbaldy

Wino Moderator
Staff member
Local time
Yesterday, 23:03
Joined
Aug 30, 2003
Messages
36,118
Where do you want to use it? Basically you call the function from anyplace (query, VBA, form, etc). In VBA:

VariableName = fOSUserName()

in a form textbox:

=fOSUserName()
 

RogerCooper

Registered User.
Local time
Yesterday, 23:03
Joined
Jul 30, 2014
Messages
277
To identify the users in database, open the .laccdb file in Word.
 

isladogs

MVP / VIP
Local time
Today, 06:03
Joined
Jan 14, 2017
Messages
18,186
Whilst the fOSUserName function works, a much simpler solution is just to use:
Code:
Environ("UserName")

OR if you want an external solution, you could use this utility originally by David Crake & updated by me last year: https://www.access-programmers.co.uk/forums/showthread.php?t=295174

I have a similar system in my own multi-user apps which also includes the ability to:
a) send out a warning to all current users by email
b) start a shut down procedure giving users a specified time to logout e.g. 5 minutes
c) prevent new users logging in during that time
d) email all users after routine maintenance has been completed
 

MarkK

bit cruncher
Local time
Yesterday, 23:03
Joined
Mar 17, 2004
Messages
8,178
Here's code that lists logged in users using the .laccdb file. You can adapt it to your purpose.
Code:
[SIZE="1"]Private Sub PrintConnectedComputers()
    Const FILE_NAME As String = "FileToTest.laccdb"
    Const SRC_PATH As String = "C:\SourcePath\"
    Const DST_PATH As String = "C:\DestinationPath\"
    
    Dim ts As Scripting.TextStream
    Dim tmp As String
    Dim usr As String
    Dim dic As New Scripting.Dictionary
    
[COLOR="Green"]    ' copy the existing .laccdb file, and open as stream[/COLOR]
    With New Scripting.FileSystemObject
[COLOR="green"]        ' copy (overwrite) the .laccdb file[/COLOR]
        .CopyFile SRC_PATH & FILE_NAME, DST_PATH & FILE_NAME, True
[COLOR="green"]        ' open copied file as a Scripting.TextStream[/COLOR]
        Set ts = .OpenTextFile(DST_PATH & FILE_NAME, ForReading)
    End With
    
    With ts
        Do While Not .AtEndOfStream    [COLOR="green"] ' loop thru characters in file[/COLOR]
            tmp = .Read(1)              [COLOR="green"]' read each char[/COLOR]
            Select Case Asc(tmp)        [COLOR="green"]' check each char[/COLOR]
                Case 0, 32              [COLOR="green"]' ignore spaces[/COLOR]
                Case Else               [COLOR="green"]' select everything else[/COLOR]
                    usr = usr & tmp     [COLOR="green"]' concat per user[/COLOR]
                    If Right(usr, 5) = "Admin" Then     [COLOR="green"]' test for trailing username[/COLOR]
                        usr = Replace(usr, "Admin", "") [COLOR="green"]' drop trailing username[/COLOR]
                        If Not dic.Exists(usr) Then     [COLOR="green"]' test for user already exists[/COLOR]
                            dic.Add usr, usr            [COLOR="green"]' if not, add to dictionary[/COLOR]
                        End If
                        usr = ""       [COLOR="green"] ' prepare for next connection[/COLOR]
                    End If
            End Select
        Loop
        .Close
    End With
    
    Dim var
    For Each var In dic.Keys   [COLOR="green"] ' loop thru dictionary keys and print users[/COLOR]
        Debug.Print var
    Next
    
    Debug.Print "*** End Run"
End Sub[/SIZE]
Note that one user might have multiple connections to a BE file, and once they log out, it does not seem to immediately remove all their connections. Also, this code only works if you do not have a login for the database, because it assumes all database usernames are 'Admin,' which is the default. Also, this code returns the name of the machine that is connected, not the logged in user's Windows username.
hth
Mark
 

Galaxiom

Super Moderator
Staff member
Local time
Today, 17:03
Joined
Jan 20, 2009
Messages
12,849
Whilst the fOSUserName function works, a much simpler solution is just to use:
Code:
Environ("UserName")

Of course that doesn't return the actual username but the Username Environment Variable which, although defaulted to the username, can be reset to anything.

This expression returns the username.

Code:
CreateObject("wscript.network").UserName
 

Users who are viewing this thread

Top Bottom