Don McNally: SnTT: Lookup Names in Your Active Directory Global Catalog

We are a small Domino island is a large Microsoft sea. Recently, we implemented a web service that required access by non-Notes users to one of our Notes databases. As such, we needed a way to determine which documents those users were allowed to see and we decided to use their unique corporate identifier. Rather than forcing the users to type that information in (as well as the user's name so it was easy to identify) and/or look the names up manually in some external system, we developed a dialog that uses the Active Directory Service Interface objects.

The form enables a user to enter a full or partial last name plus (optionally) a full or partial first name. When the Search button is clicked, the code looks in the Global Catalog and returns the list of names and unique IDs. Due to the 64K limit on fields, the list will only return 1000 names and will inform the user that there are more names and that they should refine their search term to reduce the list.

In the code, doc.SearchString is the field on the dialog where the user enters what they are searching for. You need to replace GlobalCatalog.url with the path to your global catalog. I did not include the code but we also implemented a sort routine to provide the returned list in alphabetical order.


Sub Click(Source As Button)
 Dim ws As New NotesUIWorkspace
 Dim doc As NotesDocument
 Dim objConnection As Variant
 Dim objCommand As Variant
 Dim LastName As String
 Dim ID As String
 Dim FN As String
 Dim LN As String
 Dim nameSearch As String
 Dim NameList() As String

 Call NEMEnableWaitCursor
 Set doc = ws.CurrentDocument.Document
 Set objConnection = CreateObject("ADODB.Connection")
 objConnection.Open "Provider=ADsDSOObject;"

 Set objCommand = CreateObject("ADODB.Command")
 Set objCommand.ActiveConnection = objConnection

 If Instr(doc.searchString(0),",") = 0 Then
  nameSearch = "(sn=" & doc.searchString(0) & "*));"
 Else
  nameSearch = "(sn=" & Strleft(doc.searchString(0),",") &_
   "*)(givenName=" & Strright(doc.searchString(0),",") & "*));"
 End If

 objCommand.CommandText = _
 ";" & _
 "(&(objectCategory=person)(objectClass=user)" & _
 nameSearch & _
 "sAMAccountName, givenName, sn;subtree"

 On Error Goto LookupError
 Set objRecordSet = objCommand.Execute
 On Error Resume Next

 x = 0
 Redim Preserve NameList(x)
 While Not objRecordset.EOF
  ID = objRecordset.Fields("sAMAccountName").value
 Redim Preserve NameList(x)
   If Isnull(objRecordset.Fields("sn").Value) Then
    LN = ""
   Else
    LN = objRecordset.Fields("sn").Value
   End If
   If Isnull(objRecordset.Fields("givenName").Value) Then
    FN = ""
   Else
    FN = objRecordset.Fields("givenName").Value
   End If
   NameList(x) = LN & ", " & FN & nl & " (" & ID & ")"
   If x >= 1000 Then
    Messagebox "Your search produced a very large list of names so the list only " &_
    "includes the first 1,000 found.  If the name you are looking for is not in the list, " &_
    "try searching again with more of the last name and/or first name.",64,"Large Result"
    Goto DisplayIt
   End If
   x = x +1
  End If
  objRecordset.MoveNext
 Wend

DisplayIt:
 Call NEMDisableWaitCursor
 If NameList(0) = "" Then
  Messagebox "No users found meeting your criteria; please revise " &_
  "and try again",64,"Name Lookup"
  Exit Sub
 End If

 objConnection.Close

 doc.searchResults = sortValues(NameList)
 Call ws.CurrentDocument.Reload
 Call ws.CurrentDocument.Refresh
 Exit Sub

LookupError:
 Messagebox "The search caused an error, most likely because you " &_
  "are not on the network.  Please try the lookup again later.",48,"Error"
 Call NEMDisableWaitCursor
 objConnection.Close
 End
End Sub