[VBA] Code to Query Outlook LDAP Attributes Not Working After Switch to Outlook 2013

[Sunjinsak]

Hello again guys.

The organisation I work for has very recently upgraded from Outlook 2010 to Outlook 2013. For the past few years I’ve been using the below code in various Excel Workbooks but since the change to Outlook 2013 it’s stopped working properly.

I can’t remember where I got the code from now but I didn’t write it myself so my understanding of it is lacking unfortunately.

The code consists of 3 functions as follows…

GetPID:

Public Function GetPID() As String
'// Finds the user's Personnel ID (same as Windows login/user name)




    Dim objNet
    Set objNet = CreateObject("wscript.network")
    GetPID = objNet.UserName


End Function

GetName:

Public Function GetName(strPIDToLookUp As String) As String
'// Finds a user's name from Outlook's Global Address List (GAL) based on their
'// Personnel ID (PID)


'// Can be used in conjunction with the GetPID() function to
'// get the name of the current user - e.g - GetName(GetPID)




    Const adOpenStatic As Integer = 3
    Const adLockReadOnly As Integer = 1
    Const adCmdUnspecified As Integer = -1


    Dim rstrecords
    Dim strSQLQuery


    Set rstrecords = CreateObject("ADODB.Recordset")


    strSQLQuery = "SELECT displayName, givenName, sn FROM 'LDAP://userdomain01.domroot.internal' " & _
                  "WHERE userPrincipalName='" & strPIDToLookUp & "*'"


    With rstrecords


        .Open strSQLQuery, "Provider=ADSDSOObject;", adOpenStatic, adLockReadOnly, _
        adCmdUnspecified


            If Not (.BOF And .EOF) Then
                GetName = .Fields(1).Value & " " & .Fields(0).Value
            Else
                GetName = "?"
            End If
            
    End With


End Function

GetAttribute:

Public Function GetAttribute(strPID As String, strAttribute As String) As Variant
'// Finds an LDAP attribute for a user from the GAL using their PID


'// Use the following in your code to get values for a specific user (example PID 1234567):


' Forename(s) - GetAttribute("1234567", "givenName")
' Surname - GetAttribute("1234567", "SN")
' Initials - GetAttribute("1234567", "initials")
' Title - GetAttribute("1234567", "title")
' Full Name - GetAttribute("1234567", "CN")
' Telephone - GetAttribute("1234567", "telephoneNumber")


'// Can also be used in conjunction with the GetPID() Function as follows:


' Forename(s) - GetAttribute(GetPID, "givenName")
' Surname - GetAttribute(GetPID, "SN")
' etc...


'// A list of LDAP attributes can be found at:
'// http://www.manageengine.com/products/ad-manager/help/csv-import-management/active-directory-ldap-attributes.html


'-------------------------------------------------------------------------------------------------------------------




    Const adOpenStatic As Integer = 3
    Const adLockReadOnly As Integer = 1
    Const adCmdUnspecified As Integer = -1
    Dim rstrecords
    Dim strSQLQuery




    Set rstrecords = CreateObject("ADODB.Recordset")


    strSQLQuery = "SELECT " & strAttribute & " FROM 'LDAP://userdomain01.domroot.internal' " & _
                  "WHERE userPrincipalName='" & strPID & "*'"


    With rstrecords


        .Open strSQLQuery, "Provider=ADSDSOObject;", adOpenStatic, adLockReadOnly, _
        adCmdUnspecified


            If Not (.BOF And .EOF) Then
                GetAttribute = .Fields(0).Value
            Else
                GetAttribute = vbNullString
            End If


    End With


End Function

GetPID still works and returns the correct information, but the other two functions have stopped working.

GetName returns “?” no matter what personnel ID you feed into it and GetAttribute returns a vbNullString no matter what PID is fed in, so I guess the code itself is working to design but either the LDAP attributes are different in Outlook 2013 or the SQL query needs amending?

I’ve tried searching for an updated list of LDAP attributes but I can’t find one anywhere. I’ve also tried via trial and error to query different attributes, thinking maybe the info I’m after has simply been re-mapped to different attributes, but all the ones I’ve tried return vbNullString.

I appreciate this might be a problem specific to my organisation and the way it has Outlook set up but figured it would be worth a shot asking here.

Can anyone help me get this code back up and running?

Thanks!

 

[Sunjinsak]

Well I found a solution to this. I'll post it here just in case anyone has a similar problem, though I suspect this is very specific to how the organisation I work for has chosen to set up Outlook. Anyway...

It turns out that the user's Windows login name (which in our case is our individual personnel ID number) is now mapped to the LDAP attribute sAMAccountName, instead of userPrincipalName

So, after a little trial and error to find that out and a little research into SQL all I had to do to fix this was change the respective SQL queries in the code like so...

GetName:

    strSQLQuery = "SELECT givenName, sn FROM 'LDAP://userdomain01.domroot.internal' " & _
                  "WHERE sAMAccountName='" & strPIDToLookUp & "*'"

GetAttribute:

    strSQLQuery = "SELECT " & strAttribute & " FROM 'LDAP://userdomain01.domroot.internal' " & _
                  "WHERE sAMAccountName='" & strPID & "*'"

Hope this helps someone.

Cheers.