Excel VBA to Windows User FullName and Win UserID

B

Biz

Well-known Member
Joined
May 18, 2009
Messages
1,773
Office Version
  1. 2021
Platform
  1. Windows
Dear All,

I am stuck trying to get Windows User FullName and Win UserId.

Any help would be appreciated?

Biz:confused:
 

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
Sort by date Sort by votes
Hello Biz,

This should help. This will list the information for all accounts on the local computer. It can be configured to work with remote computers if you have administrator privileges.
Code: 
'Written: November 07, 2010
'Author:  Leith Ross
'Summary: Returns the information for each account on the local computer.
'         This information is copied to "Sheet3" starting at cell "A2".

Sub GetAccountsInfo()
  
  Dim colItems As Object
  Dim Msg As String
  Dim objWMIService As Object
  Dim R As Long
  Dim Rng As Range
  Dim strComputer As String
  Dim Wks As Worksheet
  
    Set Wks = Worksheets("Sheet3")
    Set Rng = Wks.Range("A2")
    
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Set colItems = objWMIService.ExecQuery("Select * from Win32_UserAccount", , 48)
    
      For Each objItem In colItems
        If Not objItem Is Nothing Then
          Msg = Msg & "AccountType: " & objItem.AccountType & vbCrLf
          Msg = Msg & "Caption: " & objItem.Caption & vbCrLf
          Msg = Msg & "Description: " & objItem.Description & vbCrLf
          Msg = Msg & "Disabled: " & objItem.Disabled & vbCrLf
          Msg = Msg & "Domain: " & objItem.Domain & vbCrLf
          Msg = Msg & "FullName: " & objItem.FullName & vbCrLf
          Msg = Msg & "InstallDate: " & objItem.InstallDate & vbCrLf
          Msg = Msg & "Lockout: " & objItem.Lockout & vbCrLf
          Msg = Msg & "Name: " & objItem.Name & vbCrLf
          Msg = Msg & "PasswordChangeable: " & objItem.PasswordChangeable & vbCrLf
          Msg = Msg & "PasswordExpires: " & objItem.PasswordExpires & vbCrLf
          Msg = Msg & "PasswordRequired: " & objItem.PasswordRequired & vbCrLf
          Msg = Msg & "SID: " & objItem.SID & vbCrLf
          Msg = Msg & "SIDType: " & objItem.SIDType & vbCrLf
          Msg = Msg & "Status: " & objItem.Status & vbCrLf
          Rng.Offset(R, 0).Resize(15, 1).Value = WorksheetFunction.Transpose(Split(Msg, vbCrLf))
          R = R + 16
          Msg = ""
        End If
      Next
    
End Sub
 
Upvote 0
;2503510 said:
Hello Biz,

This should help. This will list the information for all accounts on the local computer. It can be configured to work with remote computers if you have administrator privileges.
Code: 
'Written: November 07, 2010
'Author:  Leith Ross
'Summary: Returns the information for each account on the local computer.
'         This information is copied to "Sheet3" starting at cell "A2".
 
Sub GetAccountsInfo()
 
  Dim colItems As Object
  Dim Msg As String
  Dim objWMIService As Object
  Dim R As Long
  Dim Rng As Range
  Dim strComputer As String
  Dim Wks As Worksheet
 
    Set Wks = Worksheets("Sheet3")
    Set Rng = Wks.Range("A2")
 
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Set colItems = objWMIService.ExecQuery("Select * from Win32_UserAccount", , 48)
 
      For Each objItem In colItems
        If Not objItem Is Nothing Then
          Msg = Msg & "AccountType: " & objItem.AccountType & vbCrLf
          Msg = Msg & "Caption: " & objItem.Caption & vbCrLf
          Msg = Msg & "Description: " & objItem.Description & vbCrLf
          Msg = Msg & "Disabled: " & objItem.Disabled & vbCrLf
          Msg = Msg & "Domain: " & objItem.Domain & vbCrLf
          Msg = Msg & "FullName: " & objItem.FullName & vbCrLf
          Msg = Msg & "InstallDate: " & objItem.InstallDate & vbCrLf
          Msg = Msg & "Lockout: " & objItem.Lockout & vbCrLf
          Msg = Msg & "Name: " & objItem.Name & vbCrLf
          Msg = Msg & "PasswordChangeable: " & objItem.PasswordChangeable & vbCrLf
          Msg = Msg & "PasswordExpires: " & objItem.PasswordExpires & vbCrLf
          Msg = Msg & "PasswordRequired: " & objItem.PasswordRequired & vbCrLf
          Msg = Msg & "SID: " & objItem.SID & vbCrLf
          Msg = Msg & "SIDType: " & objItem.SIDType & vbCrLf
          Msg = Msg & "Status: " & objItem.Status & vbCrLf
          Rng.Offset(R, 0).Resize(15, 1).Value = WorksheetFunction.Transpose(Split(Msg, vbCrLf))
          R = R + 16
          Msg = ""
        End If
      Next
 
End Sub
Click to expand...

Hi Leith Ross,

Your code was awesome and it works I just needed to add Dim objItem As Object in declaration.<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>

You must hardcore programmer mate.
Question how do I configure for remote computers too?
Biz
 
Upvote 0
Hi Leith,

Thank you for weblink.

Biz
 
Upvote 0
Hi,

I am still not sure how to get all users windows full name and windows Id on remote computers. I found code that can give network login name,Full name for a given UserID & network login name.


Code: 
Option Explicit
Private Type USER_INFO_2
    usri2_name As Long
    usri2_password  As Long  ' Null, only settable
    usri2_password_age  As Long
    usri2_priv  As Long
    usri2_home_dir  As Long
    usri2_comment  As Long
    usri2_flags  As Long
    usri2_script_path  As Long
    usri2_auth_flags  As Long
    usri2_full_name As Long
    usri2_usr_comment  As Long
    usri2_parms  As Long
    usri2_workstations  As Long
    usri2_last_logon  As Long
    usri2_last_logoff  As Long
    usri2_acct_expires  As Long
    usri2_max_storage  As Long
    usri2_units_per_week  As Long
    usri2_logon_hours  As Long
    usri2_bad_pw_count  As Long
    usri2_num_logons  As Long
    usri2_logon_server  As Long
    usri2_country_code  As Long
    usri2_code_page  As Long
End Type
 
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 wide 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 fGetFullNameOfLoggedUser(Optional strUserName As String) As String
'
' Returns the full name for a given UserID
'   NT/2000 only
' Omitting the strUserName argument will try and
' retrieve the full name for the currently logged on user
'
On Error GoTo ErrHandler
Dim pBuf As Long
Dim dwRec As Long
Dim pTmp As USER_INFO_2
Dim abytPDCName() As Byte
Dim abytUserName() As Byte
Dim lngRet As Long
Dim i As Long
 
    ' Unicode
    abytPDCName = fGetDCName() & vbNullChar
    If (Len(strUserName) = 0) Then strUserName = fGetUserName()
    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))
        fGetFullNameOfLoggedUser = fStrFromPtrW(pTmp.usri2_full_name)
    End If
 
    Call apiNetAPIBufferFree(pBuf)
ExitHere:
    Exit Function
ErrHandler:
    fGetFullNameOfLoggedUser = vbNullString
    Resume ExitHere
End Function
 
Private Function fGetUserName() 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
        fGetUserName = Left$(strUserName, lngLen - 1)
    End If
End Function
 
Function fGetDCName() As String
Dim pTmp As Long
Dim lngRet As Long
Dim abytBuf() As Byte
 
    lngRet = apiNetGetDCName(0, 0, pTmp)
    If lngRet = NERR_SUCCESS Then
        fGetDCName = fStrFromPtrW(pTmp)
    End If
    Call apiNetAPIBufferFree(pTmp)
End Function
 
Private Function fStrFromPtrW(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
        fStrFromPtrW = abytBuf
    End If
End Function
 
Upvote 0
Hello Biz,

You must have administrative and security access rights to the remote computer whether you are using API or WMI. Your operating system plays a part in this as well. The calls needed may change based on the operating system you have and the OS of the remote. What is the OS of your system? What are the OS' of the other systems?
 
Upvote 0
Hello Leith,

I have admin rights. OS is Windows 7.0 and I think we have Windows Exchange v2003 at work.

I was thinking it would be easier to embed my username or default username so that users of timesheets when they commit their timesheets
can API or WMI and access User Full Name.

Kind Regards,

Biz
 
Upvote 0
Hello Biz,

I am heading off to bed. It is 12:30 am here in California. I can't really answer your question regarding Exchange Server. I do know that is has its own rules and methods of retrieval. When you say full user name, do mean like the individual's name i.e., "Leith Ross"?
 
Upvote 0
Leith Ross said:
This will list the information for all accounts on the local computer.
Code: 
'Written: November 07, 2010
'Author:  Leith Ross
'Summary: Returns the information for each account on the local computer.
'         This information is copied to "Sheet3" starting at cell "A2".
 
Sub GetAccountsInfo()
:
... etc.
Click to expand...
Lurking - just popped up to say thanks for posting this code!
 
Upvote 0
You must log in or register to reply here.

Similar threads

rpaulson
  • Question Question
VAB SQL Statement
Replies
5
Views
242
rpaulson
rpaulson
S
  • Solved
If Dir(FullName) <> vbNull String Then Giving Runtime Error 52
Replies
5
Views
297
StedDOOM
S
H
  • Question Question
How to login with username and password via Microsoft Edge in VBA code
Replies
1
Views
1K
healeydm
H
K
  • Question Question
Call cell value Macro
Replies
1
Views
205
karldugan
K
B
  • Solved
checking winning lotto numbers
Replies
8
Views
842
JerrExcel
JerrExcel

Forum statistics

Threads
1,223,904
Messages
6,175,295
Members
452,632
Latest member
jladair

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top