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.