Get Full User Name - Need 32 bit and 64 bit functionality

[jlgray0127]

Hello. My PC was recently updated from a 32 bit to a 64 bit system. My code stopped working. I will paste the full code below, highlighted red where the error appears to be and not sure what I am missing.
I also tried running this for just a 64bit and it did not work when I added the PTRSAFE after DECLARE, as I seen on many forums. I really need this to work on both 32 bit and 64 bit as we have about 20 users now who work in this database. Thank you in advance!



Option Compare Database


Private Type ExtendedUserInfo
EUI_name As Long
EUI_password As Long ' Null, only settable
EUI_password_age As Long
EUI_priv As Long
EUI_home_dir As Long
EUI_comment As Long
EUI_flags As Long
EUI_script_path As Long
EUI_auth_flags As Long
EUI_full_name As Long
EUI_usr_comment As Long
EUI_parms As Long
EUI_workstations As Long
EUI_last_logon As Long
EUI_last_logoff As Long
EUI_acct_expires As Long
EUI_max_storage As Long
EUI_units_per_week As Long
EUI_logon_hours As Long
EUI_bad_pw_count As Long
EUI_num_logons As Long
EUI_logon_server As Long
EUI_country_code As Long
EUI_code_page As Long
End Type


'Windows API function declarations
Private Declare PtrSafe Function apiNetGetDCName Lib "netapi32.dll" _
Alias "NetGetDCName" (ByVal servername As Long, _
ByVal DomainName As Long, _
bufptr As Long) As Long


' function frees the memory that the NetApiBufferAllocate function allocates.
Private Declare PtrSafe Function apiNetAPIBufferFree Lib "netapi32.dll" _
Alias "NetApiBufferFree" (ByVal buffer As Long) As Long


' Retrieves the length of the specified Unicode string.
Private Declare PtrSafe Function apilstrlenW Lib "kernel32" _
Alias "lstrlenW" (ByVal lpString As Long) As Long


Private Declare PtrSafe Function apiNetUserGetInfo Lib "netapi32.dll" _
Alias "NetUserGetInfo" (servername As Any, _
UserName As Any, _
ByVal level As Long, _
bufptr As Long) As Long


' moves memory either forward or backward, aligned or unaligned,
' in 4-byte blocks, followed by any remaining bytes
#If VBA7 Then
Private Declare PtrSafe Sub sapiCopyMem Lib "kernel32" _


Alias "RtlMoveMemory" (Destination As Any, _
Source As Any, _
ByVal Length As LongPtr)
#Else
Private Declare Sub sapiCopyMem Lib "kernel32" _
Alias "RtlMoveMemory" (Destination As Any, _
Source As Any, _
ByVal Length As Long)
#End If


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


Private Const MAXCOMMENTSZ = 256
Private Const NERR_SUCCESS = 0
Private Const ERROR_MORE_DATA = 234&
Private Const MAX_CHUNK = 25
Private Const ERROR_SUCCESS = 0&


Function GetFullNameOfLoggedUser(Optional strUserName As String) As String
'
' Returns the full name for a given network username (NT/2000/XP only)
' Omitting the argument will retrieve the full name for the currently logged on user
'
On Error GoTo Err_GetFullNameOfLoggedUser
Dim pBuf As Long
Dim dwRec As Long
Dim pTmp As ExtendedUserInfo
Dim abytPDCName() As Byte
Dim abytUserName() As Byte
Dim lngRet As Long
Dim i As Long


' Unicode
abytPDCName = GetDCName() & vbNullChar
If (Len(strUserName) = 0) Then
strUserName = GetUserName()
End If
abytUserName = strUserName & vbNullChar


' Level 2
lngRet = apiNetUserGetInfo(abytPDCName(0), abytUserName(0), 2, pBuf)
If (lngRet = ERROR_SUCCESS) Then
Call sapiCopyMem(pTmp, ByVal pBuf, Len(pTmp))
GetFullNameOfLoggedUser = StrFromPtrW(pTmp.EUI_full_name)
gvusername = abytUserName
End If


Call apiNetAPIBufferFree(pBuf)


Exit_GetFullNameOfLoggedUser:
Exit Function


Err_GetFullNameOfLoggedUser:
MsgBox Err.Description, vbExclamation
GetFullNameOfLoggedUser = vbNullString
Resume Exit_GetFullNameOfLoggedUser
End Function


Private Function GetUserName() As String
' Returns the network login name
Dim lngLen As Long, lngRet As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngRet = apiGetUserName(strUserName, lngLen)
If lngRet Then
GetUserName = Left$(strUserName, lngLen - 1)
End If
End Function


Function GetDCName() As String
Dim pTmp As Long
Dim lngRet As Long
Dim abytBuf() As Byte


lngRet = apiNetGetDCName(0, 0, pTmp)
If lngRet = NERR_SUCCESS Then
GetDCName = StrFromPtrW(pTmp)
End If
Call apiNetAPIBufferFree(pTmp)
End Function


Private Function StrFromPtrW(pBuf As Long) As String
Dim lngLen As Long
Dim abytBuf() As Byte


' Get the length of the string at the memory location
lngLen = apilstrlenW(pBuf) * 2
' if it's not a ZLS
If lngLen Then
ReDim abytBuf(lngLen)
' then copy the memory contents
' into a temp buffer
Call sapiCopyMem(abytBuf(0), ByVal pBuf, lngLen)
' return the buffer
StrFromPtrW = abytBuf
End If
End Function

[Welshgasman]

Use conditional compilation?
What is wrong with Environ() ?

[Micron]

I suggest you post code within code tags to maintain indentation and readability. Use # button on posting toolbar. Some people won't bother to read that, but your choice of course. As WGM is saying, you can probably get by with Environ("UserName") if that's all you need. Apparently the only way to generate a list is to run code for that. I imagine there is a complete list posted somewhere.
EDIT - to get the full user name as you asked, you'd look up the Windows username via that function, then get whatever related details (Fname, Lname, Dept. etc.) from your user table.

[Welshgasman]

I think that red is just because you are on 64bit. If you put that on a 32bit access the other block would be red?