Excel VBA to Windows User FullName and Win UserID

'Written: July 08, 2010
'Updated: November 08, 2010  -  Improved error handling and added a Class Module
'         ExtendedNameFormat to make selecting the Domain Name format easier.
'Author:  Leith Ross
'Summary: API call to return the User Domain Name. Requires Windows 2000 or later.
'         If successful the domain name is returned in the requested format.
'         If an error occurs the return value is an empty string and an error message
'         is displayed. Error messages can be suppressed by setting Silent to True.
'
'NOTE:    This module requires the ExtendedNameFormat Class module.


'Retrieves the name of the user or other security principal associated with the
'calling thread. You can specify the format of the returned name.
 Private Declare Function GetUserNameEx _
   Lib "secur32.dll" Alias "GetUserNameExA" _
     (ByVal NameFormat As Long, _
      ByVal lpNameBuffer As String, _
      ByRef nSize As Long) _
   As Long

Private Function GetUserDomainName(ByVal NameFormat As Long, Optional Silent As Boolean) As String

  Dim Buffer As String
  Dim BuffLen As Long
  Dim BuffSize As Long
  Dim Msg As String
  Dim NameFormatEx As New ExtendedNameFormat
  Dim RetVal As Long
    
   Const ERROR_MORE_DATA = 234&
   Const ERROR_NO_SUCH_DOMAIN = 1355&
   Const ERROR_NONE_MAPPED = 1332&
   
    BuffSize = 520
    Buffer = String(BuffSize, Chr$(0))
    BuffLen = BuffSize
    
      RetVal = GetUserNameEx(NameFormat, Buffer, BuffLen)
      
          Select Case Err.LastDllError
            Case ERROR_MORE_DATA
              Msg = "Buffer is to small to hold domain name."
            Case ERROR_NO_SUCH_DOMAIN
              Msg = "Domain name doesn't exist."
            Case ERROR_NONE_MAPPED
              Msg = "The user name is not available in the specified format."
            Case Else
          
              Select Case (BuffLen / 2)
                Case Is > BuffSize
                  Msg = "Error: The domain name is larger than the buffer can hold."
                Case Is = BuffSize
                  Msg = "No Domain information was returned."
                Case Else
                  GetUserDomainName = Left$(Buffer, BuffLen - 1): Exit Function
              End Select
              
          End Select
          
    If Not Silent Then
      MsgBox Msg, vbOKOnly, NameFormatEx.GetNameFormatString(NameFormat) & " - Error"
    End If
    
End Function

'Written: November 08, 2010
'Author:  Leith Ross
'Summary: This class is used with the Get_User_Domain_API module.


'UnknownName - An unknown name type.
'
'FullyQualifiedDN - The fully-qualified distinguished name (for example, CN=Jeff Smith,OU=Users,DC=Engineering,DC=Microsoft,DC=Com).
'
'SamCompatibleName - A legacy account name (for example, Engineering\JSmith). The domain-only version includes trailing backslashes (\\).
'
'DisplayName - A "friendly" display name (for example, Jeff Smith). The display name is not necessarily the defining relative distinguished name (RDN).
'
'UniqueIdName - A GUID string that the IIDFromString function returns (for example, {4fa050f0-f561-11cf-bdd9-00aa003a77b6}).
'
'CanonicalName - The complete canonical name (for example, engineering.microsoft.com/software/someone). The domain-only version includes a trailing forward slash (/).
'
'UserPrincipalName - The user principal name (for example, someone@example.com).
'
'CanonicalExName - The same as NameCanonical except that the rightmost forward slash (/) is replaced with a new line character (\n), even in a domain-only case (for example, engineering.microsoft.com/software\nJSmith).
'
'ServicePrincipalName - The generalized service principal name (for example, www/www.microsoft.com@microsoft.com).
'
'DnsDomainName - The DNS domain name followed by a backward-slash and the SAM user name.
  

Private Const pvtUnKnownName = 0&
Private Const pvtFullyQualifiedDistinguishedName = 1&
Private Const pvtSamCompatibleName = 2&
Private Const pvtDisplayName = 3&
Private Const pvtUniqueIDName = 6&
Private Const pvtCanonicalName = 7&
Private Const pvtUserPrincipalName = 8&
Private Const pvtCanonicalNameEx = 9&
Private Const pvtServicePrincipalName = 10&
Private Const pvtDnsDomainName = 12&

Property Get UnKnownName() As Long
  UnKnowName = pvtUnKnowName
End Property

Property Get FullyQualifiedDistinguishedName() As Long
  FullyQualifiedDistinguishedName = pvtFullyQualifiedDistinguishedName
End Property

Property Get SamCompatibleName() As Long
  SamCompatibleName = pvtSamCompatibleName
End Property

Property Get DisplayName() As Long
  DisplayName = pvtDisplayName
End Property

Property Get UniqueIDName() As Long
  UniqueIDName = pvtUniqueIDName
End Property

Property Get CanonicalName() As Long
  CanonicalName = pvtCanonicalName
End Property

Property Get UserPrincipalName() As Long
  UserPrincipalName = pvtUserPrincipalName
End Property

Property Get CanonicalNameEx() As Long
  CanonicalNameEx = pvtCanonicalNameEx
End Property

Property Get ServicePrincipalName() As Long
  ServicePrincipalName = pvtServicePrincipalName
End Property

Property Get DnsDomainName() As Long
  DnsDomainName = pvtDnsDomainName
End Property

Function GetNameFormatString(ByVal NameFormat As Long) As String
  Select Case NameFormat
    Case 0: GetNameFormatString = "Unknown Name"
    Case 1: GetNameFormatString = "Fully Qualified Distinguished Name"
    Case 2: GetNameFormatString = "SAM Compatible Name"
    Case 3: GetNameFormatString = "Display Name"
    Case 6: GetNameFormatString = "Unique ID Name"
    Case 7: GetNameFormatString = "Canonical Name"
    Case 8: GetNameFormatString = "User Principal Name"
    Case 9: GetNameFormatString = "Canonical Name Extended"
    Case 10: GetNameFormatString = "Service Principal Name"
    Case 12: GetNameFormatString = "DNS Domain Name"
  End Select
End Function

Sub DomainNameTest()

  Dim Domain As String
  Dim NameFormatEx As New ExtendedNameFormat
  
    Domain = GetUserDomainName(NameFormatEx.UserPrincipalName, True)
    If Domain = "" Then Domain = GetUserDomainName(NameFormatEx.SamCompatibleName)
    
    MsgBox Domain, vbOKOnly, "User Domain Name"
    
End Sub