Get your AD Details

Sample-Code  to retrieve  some Windows-Account-Details via LotusScript.   Thank you to Dietrich Vogel.


Sub Click(Source As Button)
On Error Goto error_handle
Dim objConnection As Variant
Dim objCommand As Variant
Dim objRecordSet  As Variant
Dim NameToSearch As String
Dim SearchScope As String

'   Define the AD Search Scope.   Details depends on the AD-Structure  you're in.
SearchScope = "dc=ad,dc=eu,dc=rf-group,dc=org"


' Get the windows-name  with which you logged on
NameToSearch=Inputbox("Login-Accunt to search: ","Windows Accounts Check", Environ$("username"))

' Create an AD-Connection
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=ADsDSOObject;"

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

' Prepare the search String   =>  see our AD-friends for more details; other parameters to retrieve, etc
objCommand.CommandText = _
"<GC://" & SearchScope & ">;" & _
"(&(objectClass=user)" & "(sAMAccountName=" & NameToSearch & "));" & _
"sAMAccountName, distinguishedName, cn, sn,givenName, mail;subtree"

' Execute the search
Set objRecordSet = objCommand.Execute

'  Show the result
If objRecordSet.RecordCount = 0 Then
Msgbox "The sAMAccountName is not in use."
Else
While Not objRecordset.EOF
Msgbox "DistinguishedName = " & objRecordset.Fields("distinguishedName").value, ,"AD Distinguished Name for " & NameToSearch
' Msgbox "sAMAccountName = " &  objRecordset.Fields("sAMAccountName").value
' Msgbox "cn = " & objRecordset.Fields("cn").value
' Msgbox "sn = " & objRecordset.Fields("sn").value
' Msgbox "givenName = " & objRecordset.Fields("givenName").value
Msgbox "MailAddress = " & objRecordset.Fields("mail").value, ,"AD MailAddress  for " & NameToSearch
objRecordset.MoveNext
Wend
End If

' and finish off
ex_sub:
On Error Resume Next
objConnection.Close
Exit Sub

' of course we never get errors.  But    just in case... Show where/wat's wrong   and then ex.
error_handle:
Messagebox "Error in line " & Str(Erl()) & ": " & Error$
Resume ex_sub
End Sub