4

I have an Access database that needs to check the username of the user using Environ("USERNAME").
While this works for my users who are using Win7, I have recently upgraded to Win8 and the code returns the text "User" on my laptop. I have also tried CreateObject("WScript.Network").Username with the same result.

  1. Is this a windows 8 thing and will I have a problem when the other users upgrade?
  2. Is there a way that I can change/configure this "User" text? My laptop is not connected to the corporate network that the other users are using so it may be that when they upgrade to Win8 their laptops will return the correct network username.
Gord Thompson
  • 116,920
  • 32
  • 215
  • 418
Gordon
  • 1,165
  • 1
  • 7
  • 12
  • 2
    so what is the name of the current windows user? – serakfalcon Jun 08 '14 at 15:40
  • The possible duplicate SO answer uses a win32 api and is more likely to remain compatible as version changes: http://stackoverflow.com/questions/168659/how-can-i-get-the-currently-logged-in-windows-user-in-access-vba/168682 – ron tornambe Jun 08 '14 at 16:03
  • On the Windows 8 Start Page (if you are looking at the Windows Desktop then tap the [Windows] key to get there), what does the top-right corner look like? Mine looks like [this](http://i.stack.imgur.com/Oc2y1.png), and `Environ("USERNAME")` returns "Gord" when I call it. – Gord Thompson Jun 08 '14 at 16:21
  • Thanks Gord, mine shows my email address. I have just now seen that in the Options menu for MS Access and also Excel there is a section called "Personalize your copy of Microsoft Office" and it's here that the username is set to "User". This pretty much solves the mystery for me and I'm hoping that the laptops on the company network will have these fields populated correctly and locked down. – Gordon Jun 08 '14 at 21:50

4 Answers4

1

I would use this Windows API call:

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

    Public Function GetWindowsUserName() As String
        Dim strUserName As String
        strUserName = String(100, Chr$(0))
        GetUserName strUserName, 100
        GetWindowsUserName = Left$(strUserName, InStr(strUserName, Chr$(0)) - 1)
    End Function
hennep
  • 545
  • 4
  • 12
1

I don't have enough reputation to add a comment to @Jens answer above, but he asks for a comment to cite source of the code he offers. I also have been using that code very successfully for some time, but I DO have the source. Here's what I put in my comments:

https://www.ozgrid.com/forum/forum/help-forums/excel-general/44878-inserting-users-full-name?t=53772

'user robertcowan provided this solution

'This is a bit too much like hard work but the following will work on NT/2000/XP/2003. You call the function
'  GetFullNameOfLoggedUser(). If called with no argument it returns the full name property of the currently
'  logged on user from the authenticating domain controller. If called with an argument specifying a valid
'  network user name it returns the full name for that user as stored on the authenticating DC for the
'  CURRENT user. It will normally return correct results but if a change to a user's full name is made on
'  one domain controller and the change hasn't propagated to the DC that authenticated your logon, the old
'  value of the full name will be returned instead of the new.

This still works fine with Win10 and MS365 32 bit. I'm trying to update it for 64bit.

laxEagle
  • 11
  • 2
0

You should be able to do this using a WMI query.

Function GetFullName() As String
    Dim computer As String
    computer = "."

    Dim objWMIService, colProcessList As Object
    Set objWMIService = GetObject("winmgmts:\\" & computer & "\root\cimv2")
    Set colProcessList = objWMIService.ExecQuery _
        ("SELECT TOP 1 * FROM Win32_Process WHERE Name = 'ACCESS.EXE'")

    Dim uname, udomain As String
    Dim objProcess As Object
    For Each objProcess In colProcessList
        objProcess.GetOwner uname, udomain
    Next
    GetFullName = UCase(udomain) & "\" & UCase(uname)
End Function

If you don't need the context, just remove "UCase(udomain) & "\" &"

Lucretius
  • 1,053
  • 1
  • 13
  • 26
0

I have been using the following module for a few months now. It ultimatly returns the full name of the current user, but you are ofcourse able to get all the data you need. This code has never failed me before, including windows 8 if I'm not mistaking. You can call the code with "GetFullNameOfLoggedUser()"
Please note that this is not my code! I have not been able to retrace where I found the code, so if someone knows, please comment to give him the credit!

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 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 Function apiNetAPIBufferFree Lib "netapi32.dll" _
Alias "NetApiBufferFree" (ByVal buffer As Long) As Long

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

Private Declare 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
Private Declare Sub sapiCopyMem Lib "kernel32" _
Alias "RtlMoveMemory" (Destination As Any, _
Source As Any, _
ByVal Length As Long)

Private Declare 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
Jens
  • 879
  • 12
  • 34