Display GAL in Excel to get Alias or Email Adress

Question

I am trying to make use of information found in THIS POST. I have 2 issues:

1. 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")

2. 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