Get fields from LDAP

[EDN Admin]

I have a code that I found as a VBS and ported it to VBA and works perfectly, but I am now trying to run on VB.NET 2010 but am getting a Path not found error. I am trying to get the complete name and e-mail from the Acitive Directory from the current user.


<div style="color:Black;background-color:White; <pre>
<span style="color:Blue; Function FindUser()
<span style="color:Blue; On <span style="color:Blue; Error <span style="color:Blue; GoTo Err

<span style="color:Blue; Dim objRoot <span style="color:Blue; As <span style="color:Blue; Variant
<span style="color:Blue; Dim LDAPdomainName <span style="color:Blue; As <span style="color:Blue; String
<span style="color:Blue; Dim UserName <span style="color:Blue; As <span style="color:Blue; String
<span style="color:Blue; Dim UserDomain <span style="color:Blue; As <span style="color:Blue; String

<span style="color:Blue; Dim cn <span style="color:Blue; As <span style="color:Blue; Variant
<span style="color:Blue; Dim cmd <span style="color:Blue; As <span style="color:Blue; Variant
<span style="color:Blue; Dim rs <span style="color:Blue; As <span style="color:Blue; Variant


UserName = VBA.Environ(<span style="color:#A31515; "UserName") <span style="color:Green; Gets Current User
UserDomain = VBA.Environ(<span style="color:#A31515; "UserDomain") <span style="color:Green; Gets Current Users Domain


<span style="color:Blue; Set objRoot = GetObject(<span style="color:#A31515; "LDAP://RootDSE")
Domain= objRoot.<span style="color:Blue; Get(<span style="color:#A31515; "defaultNamingContext")



<span style="color:Blue; Set cn = CreateObject(<span style="color:#A31515; "ADODB.Connection")
<span style="color:Blue; Set cmd = CreateObject(<span style="color:#A31515; "ADODB.Command")
<span style="color:Blue; Set rs = CreateObject(<span style="color:#A31515; "ADODB.Recordset")

cn.Open <span style="color:#A31515; "Provider=ADsDSOObject;"

cmd.activeconnection = cn
<span style="color:Green; cmd.commandtext = "SELECT ADsPath FROM LDAP://" & Domain & " WHERE sAMAccountName = " & UserName & ""
<span style="color:Green; To see all attributes names available, connect with Active Directory Explorer and add to Select.
cmd.commandtext = <span style="color:#A31515; "SELECT cn, mail FROM LDAP://" & Domain & <span style="color:#A31515; " WHERE sAMAccountName = " & UserName & <span style="color:#A31515; ""
<span style="color:Blue; Set rs = cmd.Execute


<span style="color:Blue; Do <span style="color:Blue; Until rs.EOF
Debug.Print rs(<span style="color:#A31515; "cn") & <span style="color:#A31515; " E-mail: " & rs(<span style="color:#A31515; "mail")
rs.MoveNext
<span style="color:Blue; Loop


Exit_Err:
<span style="color:Blue; If <span style="color:Blue; Not rs <span style="color:Blue; Is <span style="color:Blue; Nothing <span style="color:Blue; Then rs.Close
<span style="color:Blue; If <span style="color:Blue; Not cn <span style="color:Blue; Is <span style="color:Blue; Nothing <span style="color:Blue; Then cn.Close
<span style="color:Blue; Set rs = <span style="color:Blue; Nothing
<span style="color:Blue; Set cmd = <span style="color:Blue; Nothing
<span style="color:Blue; Set cn = <span style="color:Blue; Nothing
<span style="color:Blue; Exit <span style="color:Blue; Function

Err:
<span style="color:Blue; If Err <> 0 <span style="color:Blue; Then
MsgBox <span style="color:#A31515; "Error connecting to Active Directory Database: " & Err.Description
<span style="color:Blue; Else
<span style="color:Blue; If <span style="color:Blue; Not rs.BOF <span style="color:Blue; And <span style="color:Blue; Not rs.EOF <span style="color:Blue; Then
rs.MoveFirst
MsgBox rs(0)
<span style="color:Blue; Else
MsgBox <span style="color:#A31515; "Not Found"
<span style="color:Blue; End <span style="color:Blue; If
<span style="color:Blue; End <span style="color:Blue; If
<span style="color:Blue; Resume Exit_Err


<span style="color:Blue; End <span style="color:Blue; Function
[/code]
<br/>
<br/>



View the full article