Application.UserName

Set SI_ = CreateObject("ADSystemInfo")
Set Un_ = GetObject("LDAP://" & SI_.UserName)
UZ_ = Un_.DisplayName

Application.UserName

MsgBox Environ("UserName")

Declare Function WNetGetUserA Lib "mpr.dll" (ByVal lpName As String, ByVal lpUserName As String, lpnLength As Long) As Long

Function GetUserName() As String
       Dim sUserNameBuff As String * 255
       sUserNameBuff = Space(255)
       Call WNetGetUserA(vbNullString, sUserNameBuff, 255&)
       GetUserName = Left$(sUserNameBuff, InStr(sUserNameBuff, vbNullChar) - 1)
End Function
Sub tt()
MsgBox GetUserName
End Sub

Private Const IdentitiesSubKeyName As String = "Software\Microsoft\Office\15.0\Common\Identity\Identities"
Private Function GetIdentitiesNames()
On Error GoTo errHandle
      Const HKEY_CURRENT_USER = &H80000001
      Dim pReg As Object, sNames
      Set pReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
      pReg.EnumKey HKEY_CURRENT_USER, IdentitiesSubKeyName, sNames
      GetIdentitiesNames = sNames
Exit Function
errHandle:
      GetIdentitiesNames = sNames
End Function

Public Sub test()
      Const SignParamName = "\SigninName", DisplayParamName = "\FriendlyName"
      Dim Keys, i As Long, SignName As String, DisplayName As String
      Dim wshShell As Object, sKey As String
      Keys = GetIdentitiesNames
      If Not IsEmpty(Keys) Then
          Set wshShell = CreateObject("WScript.Shell")
          For i = LBound(Keys) To UBound(Keys)
              sKey = Keys(i)
              SignName = wshShell.RegRead("HKCU\" & IdentitiesSubKeyName & "\" & sKey & SignParamName)
              DisplayName = wshShell.RegRead("HKCU\" & IdentitiesSubKeyName & "\" & sKey & DisplayParamName)
              Debug.Print SignName & " === " & DisplayName
          Next
      End If
End Sub