Find Exchange User's OfficeLocation in VBA - vba

Question

When viewing someone's contact card in Outlook, there is a field for Office which gives their location. How can I find that using VBA? Here's my most functional code:
Private Function getLocation(username As String) As String
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olGAL As Outlook.AddressEntries
Dim olAddressEntry As Outlook.AddressEntry
Dim olUser As Outlook.ExchangeUser
Set olApp = New Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olGAL = olNS.AddressLists("Global Address List").AddressEntries
Set olAddressEntry = olGAL.Item(username)
Set olUser = olAddressEntry.GetExchangeUser
Debug.Print olGAL.Count 'count is 646718
Debug.Print olUser.OfficeLocation
Debug.Print olUser.Address
Debug.Print olUser.Name
getLocation = olUser.OfficeLocation
Set olApp = Nothing
Set olNS = Nothing
Set olGAL = Nothing
Set olAddressEntry = Nothing
Set olUser = Nothing
End Function
This works when I search for their actual name (EG, John Smith), but it only returns the first John Smith. How can I use their email address or alias to search?
Note: I added a reference to the Microsoft Outlook 16.0 Object Library to take advantage of Intellisense, but I plan on switching to late binding once it works.

Answer 1

So, I haven't found a way to query Exchange by email or alias because the .Item method (from the line olGAL.Item(username)) requires Either the index number of the object, or a value used to match the default property of an object in the collection. I did find a way to ensure I am getting the correct user however. The default property for the GAL is the user's name, which in my case (but may not be in everyone's case...can't find good documentation to verify this) the DistinguishedName in Active Directory. So if I search AD with the user's SAM account, I can get the user's DN. I can then search Exchange with that DN to ensure I have the correct "John Smith".
Here is my combined code:
'I pass the username (EG: johnsmit) and get the DN (eg John Smith - VP of Sales).
' This DN gets passed to the function in my question, and returns the correct location.
Private Function GetFullName(strUsername As String) As String
Dim objConnection As Object
Dim objCommand As Object
Dim objRecordSet As Object
Dim strDN As String
Dim temp As Variant
Const ADS_SCOPE_SUBTREE = 2
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.CommandText = "SELECT distinguishedName FROM 'LDAP://dc=mydomain,dc=com' WHERE objectCategory='user' AND sAMAccountName='" & strUsername & "'"
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst
Do Until objRecordSet.EOF
strDN = objRecordSet.Fields("distinguishedName").Value
temp = Split(strDN, ",")
GetFullName = Replace(temp(0), "CN=", "")
objRecordSet.MoveNext
Loop
objConnection.Close
Set objConnection = Nothing
Set objCommand = Nothing
Set objRecordSet = Nothing
End Function
If anyone has a better, faster, cheaper (one that doesn't hit the AD servers) method, I'd love to hear it.