Retrieve User ID

[JH001A]

How can I retrieve the user id of the user signed on in access. I would like to use this to mark records added or changed by user.

[NeoPa]

I'll try to write this all out again so that it makes sense.
I did it earlier and it fell into the bit-bucket on posting.

Basically the Registry has 2 places it stores this info - depending on the basic OS (Old Windows or NT Windows - which includes ALL later versions).
This is illustrated in the function below.

To get this to work I had to set up a separate module with OS access functions & utilities in.
This may or may not be necessary in your environment (you may already have something similar), but in case it is, I've included the code for the module (I've called it modOS) in this post.

I can't guarantee all the code in this post but it is free to use and I use it fairly heavily with no noticed side-effects so far.

If you don't want to use any of the code it should at least illustrate what is available to you.
FYI. In NT based OSs the user name is also available in the Environment as USERNAME.

'GetUser returns the user's logged on name.
Public Function GetUser() As String
    Dim strUserKey As String
 
    If Environ("OS") = "Windows_NT" Then
        strUserKey = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon"
        GetUser = RegRead(conHKLM, strUserKey, "DefaultUserName")
    Else
        'Windows
        strUserKey = "Network\Logon"
        GetUser = RegRead(conHKLM, strUserKey, "username")
    End If
End Function

modOS
Option Compare Database
Option Explicit
 
Public Const conHKCR = &H80000000
Public Const conHKCU = &H80000001
Public Const conHKLM = &H80000002
Public Const conHKU = &H80000003
Public Const conStandardRightsAll = &H1F0000
Public Const conReadControl = &H20000
Public Const conStandardRightsRead = (conReadControl)
Public Const conRegSz = 1
Public Const conOK = 0&
Public Const conKeyQueryValue = &H1
Public Const conKeySetValue = &H2
Public Const conKeyCreateLink = &H20
Public Const conKeyCreateSubKey = &H4
Public Const conKeyEnumerateSubKeys = &H8
Public Const conKeyNotify = &H10
Public Const conSynchronise = &H100000
Public Const conRegOptionNonVolatile = 0
Public Const conKeyAllAccess = ((conStandardRightsAll Or _
                                conKeyQueryValue Or _
                                conKeySetValue Or _
                                conKeyCreateSubKey Or _
                                conKeyEnumerateSubKeys Or _
                                conKeyNotify Or _
                                conKeyCreateLink) And _
                               (Not conSynchronise))
Public Const conKeyRead = ((conReadControl Or _
                            conKeyQueryValue Or _
                            conKeyEnumerateSubKeys Or _
                            conKeyNotify) And _
                           (Not conSynchronise))
 
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _
    Alias "RegOpenKeyExA" (ByVal hKey As Long, _
                           ByVal lpSubKey As String, _
                           ByVal ulOptions As Long, _
                           ByVal samDesired As Long, _
                           phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) _
                             As Long
Private Declare Function RegQueryValueExStr Lib "advapi32.dll" _
    Alias "RegQueryValueExA" (ByVal hKey As Long, _
                              ByVal lpValueName As String, _
                              ByVal lpReserved As Long, _
                              lpType As Long, _
                              ByVal lpData As String, _
                              lpcbData As Long) As Long
 
Public Function RegRead(ByVal lngHive As Long, _
                        ByVal strKey As String, _
                        ByVal strValue As String) As Variant
    Dim intIdx As Integer, intHK As Integer
    Dim strWork As String
    Dim lngRet As Long, lngLen As Long, lngHKey As Long, lngType As Long
 
    RegRead = Null
    strKey = strKey & Chr(0)
    lngRet = RegOpenKeyEx(lngHive, strKey, 0, conKeyRead, lngHKey)
    If lngRet = conOK Then
        'Create buffer to store value
        strWork = Space(255)
        lngLen = 255
        lngRet = RegQueryValueExStr(lngHKey, _
                                    strValue, _
                                    0&, _
                                    lngType, _
                                    strWork, _
                                    lngLen)
        RegRead = Left(strWork, lngLen - 1)
        If Len(RegRead) = 254 Then RegRead = Null
        'Close key
        Call RegCloseKey(lngHKey)
    End If
End Function

[Tanis]

Use this code in a module.

Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
 
 
Public Function GetNTUser() As String
    'Returns the network login name
Dim strUserName As String
    'Create a buffer
strUserName = String(100, Chr$(0))
    'Get user name
GetUserName strUserName, 100
    'Strip the rest of the buffer
strUserName = Left$(strUserName, InStr(strUserName, Chr$(0)) - 1)
GetNTUser = strUserName
End Function

In your table or tables, add another field, UserID In the Before Update event of the form on which your table is based, add this code. This assumes yourDB is networked.

Private Sub Form_BeforeUpdate(Cancel As Integer)
Me!UserID = GetNTUser & " " & Date
End Sub

[PeterDavis]

How can I retrieve the user id of the user signed on in access. I would like to use this to mark records added or changed by user.

There is an in built function for this in Access "currentUser()"

eg:

MsgBox("The current user is: " & CurrentUser)

[NeoPa]

CurrentUser() will return the Access Security account used rather than the PC or Network LogOn name.
If you use this to identify a user that will work well. Unfortunately, in many environments, this will return Admin.

[regikono]

Dear Tanis ,
Your code has worked perfectly for me. Thank you very much!

[NeoPa]

As this thread was started and answered on my first day as a member of The Scripts Developer Network (as was Bytes then), I'm very pleased to see that it's still able to help people, some years later.

Thank you for your post, and welcome to Bytes!