Display GAL in Excel to get Alias or Email Adress - vba

Question

I am trying to make use of information found in THIS POST.
I have 2 issues:
the following line hangs indefinitly. FIXED--- its just hidden and has no task bar item, simple search told me how to bring to to the front
strAddress = objWordApp.GetAddress(, strCode, False, 1, , , True, True).GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3A00001E")
I need to return something I can use in a TO line, so an ALIAS or a full email address. I have tested this code in WORD and it works perfrectly (remvoing the references to word) except I cannot get the correct information I need. When I pull I get an exchange distinguished name.. I need to convert this somehow to an alias or email address
/o=corperation/ou=administration/cn=my.name
BACKGROUND: the code in the previously mentioned post displayed the OUTLOOK GAL so a user can search/select a contact from it. I want to use the GAL because it can handle the 200,000+ records and includes distrobution lists.
SOFTWARE: This has to function within the OFffice 2010 suite. I don't need any backwords compatibility and future proofing is a minimal concern at the moment.
END RESULT: I basically just want a user to be able to search for a recipient and have that address end up in a cell.
Any hints would be greatly appreciated.

Answer 1

Method One: Using the GetAddress function
Does the following code still hang indefinitely for you?
Set objWordApp = CreateObject("Word.Application")
InputBox "", "", objWordApp.GetAddress(, "<PR_EMAIL_ADDRESS>", False, 1, , , True, True)
Method Two: If you know the username grab it directly
You can maybe use the LDAP directly to get this information:
Public Function GetUserEmail(ByVal userName As String) As String
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") = 1
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.CommandText = "SELECT mail FROM 'LDAP://DC=something,DC=co,DC=uk' WHERE objectCategory='user' AND sAMAccountName='" & userName & "'"
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst
If Not objRecordSet.EOF Then
GetUserEmail = objRecordSet.Fields("mail").Value
Else
GetUserEmail = vbNull
End If
End Function
Method Three: Create your own searchable form
You could create your own UserForm to bring back a list of users from the LDAP. You could choose the fields you want to search on and then allow the user to click that item to grab the email address. It's a little messy, but it should load a bit faster, since it'll only search on a name more than 3 characters long.
In this example above I created a query which searches on the givenName or sn field of the LDAP:
Private Sub txtSearch_Change()
If Len(txtSearch) > 3 Then
queryString = txtSearch
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") = 1
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.CommandText = "SELECT givenName, sn, mail FROM 'LDAP://DC=something,DC=co,DC=uk' WHERE objectCategory='user' AND (givenName = '*" & queryString & "*' Or sn = '*" & queryString & "*')"
Set objRecordset = objCommand.Execute
lvResults.ListItems.Clear
Do Until objRecordset.EOF
Set li = lvResults.ListItems.Add(, , objRecordset.Fields("givenName").Value)
li.SubItems(1) = objRecordset.Fields("sn").Value
If Not IsNull(objRecordset.Fields("mail")) Then
li.SubItems(2) = objRecordset.Fields("mail").Value
End If
objRecordset.MoveNext
Loop
End If
End Sub
Notes
Something to note, is you will need to change the LDAP string to your company domain controller. For example LDAP://DC=something,DC=co,DC=uk.
If you don't know this you can find it out by doing:
Set sysinfo = CreateObject("ADSystemInfo")
MsgBox sysinfo.userName
Note you only want to take the DC= parts.
A list of all attributes can be found here: http://www.computerperformance.co.uk/Logon/LDAP_attributes_active_directory.htm