Anything done repeatedly should be automated. For years, users would email me with an issue. I would then need their username and would use Active Directory to look it up. Because our environment is so large, users are assigned ID numbers for their username. Outlook already shows me the user’s email and other AD attributes. Why can’t it show me their username or other useful data? It can – with a macro.

Below the name of each user, in the screenshot above, is their username. This means no more searching AD for that bit of info!  Already know your usernames? You could expand Outlook in so many other ways. For example, you could show the computer name where the user is logged on or other commonly needed information!

How to Show the Active Directory Username in Outlook

If you haven’t start Outlook and press ALT + F11 to create a new macro. In the left window, expand until you see ThisOutlookSession. Paste in the following code:

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    Dim arrEID As Variant, varEID As Variant, olkItm As Object, olkPrp As Object, olkExu As Object, strUsr As String
    On Error Resume Next
    arrEID = Split(EntryIDCollection, ",")
    For Each varEID In arrEID
        Set olkItm = Session.GetItemFromID(varEID)
        If olkItm.Class = olMail Then
            Set olkExu = olkItm.Sender.GetExchangeUser
            If TypeName(olkExu) = "Nothing" Then
                strUsr = "Unknown"
            Else
                strUsr = GetUsernameFromAlias(olkExu.Alias)
            End If
            Set olkPrp = olkItm.UserProperties.Add("Username", olText, True)
            olkPrp.value = strUsr
            olkItm.Save
            Set olkPrp = Nothing
        End If
    Next
    On Error GoTo 0
    Set olkItm = Nothing
    Set olkExu = Nothing
End Sub

Function GetUsernameFromAlias(strAls As String) As String
    Dim adoCon As Object, adoRec As Object, objDSE As Object, strDNC As String, strSrc As String
    Set objDSE = GetObject("LDAP://RootDSE")
    strDNC = objDSE.get("defaultnamingcontext")
    strSrc = "'LDAP://" & strDNC & "'"
    Set adoCon = CreateObject("ADODB.Connection")
    adoCon.Provider = "ADsDSOObject"
    adoCon.CursorLocation = 3
    adoCon.Open "ADSI"
    Set adoRec = adoCon.Execute("SELECT samAccountName FROM " & strSrc & " Where objectClass='user' AND objectCategory='Person' AND mailNickname='" & strAls & "'")
    If Not adoRec.BOF And Not adoRec.EOF Then
        GetUsernameFromAlias = adoRec.Fields("samAccountName").value
    Else
        GetUsernameFromAlias = "Not Found"
    End If
    adoRec.Close
    adoCon.Close
    Set adoRec = Nothing
    Set adoCon = Nothing
    Set objDSE = Nothing
End Function

Save the macro and exit the editor. To allow our macro to run, we need to change one security setting in Outlook. Open Options and navigate to Trust Center – Trust Center Settings – Macro Settings. Change Macro Settings to Notifications for all macros.

Close Outlook and reopen it. You will be prompted to enable your macro.  Select your Inbox and then – View – Add Columns. Change the Maximum number of lines option to 3. In the next box, select User Defined Fields in Inbox. You should see a username option. Add it and then move it up so that it is listed below From and above Subject.

That’s all! Any future email will have a username value below it! If you have any questions or improvements, let me know! If you have issues copying the macro above, you can download a notepad version of it here.

*This macro was written by a much smarter guy than me. If it helps you, send him a tweet and let him know. You can find him at @TechnicLee.