Display Excel account username in a cell on open

Question

Working with Office 2013, I am trying to insert VBA code to automatically enter the employee name as it is displayed in the top right hand corner of any Office product into cell B2 upon them opening up the excel spreadsheet. The current code I am using is

Sub Auto_Open()

    Range("B2").Value = " " & Application.UserName

End Sub

However, this just makes it display "Authorized User".
What am I doing wrong?

Answer 1

I poked around at this morning. I figured this information must be stored somewhere in the registry if it isn't accessible as part of the Excel object model. This makes sense, especially if this username is part of a corporate subscription.

---

The Registry Key

I did a search in the registry for how my username showed up in Excel, and this popped up.

The FriendlyName is exactly how my username shows up in Excel. So all we need now is a method to read this registry key's FriendlyName, and that should do it :)

---

Code

Here is some code that works for me based on the location of this key. It may be slightly different on your computer, so you may need to tweak this to find the FriendlyName

Private Function GetFriendlyName() As String
On Error GoTo ErrorHandler:

    Const HKEY_CURRENT_USER = &H80000001
    Const ComputerName As String = "."

    Dim CPU                 As Object
    Dim RegistryKeyPath     As String
    Dim RegistrySubKeys()   As Variant
    Dim RegistryValues()    As Variant
    Dim SubKeyName          As Variant
    Dim SubKeyValue         As Variant
    Dim KeyPath             As String

    GetFriendlyName = vbNullString

    Set CPU = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & ComputerName & "\root\default:StdRegProv")

    'Specify where to look
    RegistryKeyPath = "Software\Microsoft\Office\" & Application.Version & "\Common\Identity\Identities"

    'Enumerate the registry keys
    CPU.EnumKey HKEY_CURRENT_USER, RegistryKeyPath, RegistrySubKeys

    'Iterate each key in the identities folder
    For Each SubKeyName In RegistrySubKeys

        'Get each value in that folder
        CPU.EnumValues HKEY_CURRENT_USER, RegistryKeyPath & "\" & SubKeyName, RegistryValues

        'Go through each value, and find the Friendly Name
        For Each SubKeyValue In RegistryValues

            If SubKeyValue = "FriendlyName" Then
                KeyPath = "HKEY_CURRENT_USER\" & RegistryKeyPath & "\" & SubKeyName & "\" & SubKeyValue

                'Read the key
                With CreateObject("Wscript.Shell")
                    GetFriendlyName = .RegRead(KeyPath)
                End With

                Exit Function
            End If

        Next

    Next

CleanExit:
    Exit Function

ErrorHandler:
    'Handle errors here
    Resume CleanExit
End Function

'Run this to see the output in the immediate window
Private Sub ExampleUsage()
    Debug.Print "The friendly name is: " & GetFriendlyName
End Sub

---

Results

The friendly name is: Ryan A. Wildry