query only certain attributes with visual basic

[dljordaneku]

I am having some issues querying our ldap from a vb app I wrote. I can only query certain attributes.


Option Explicit
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strname As String
Dim A As Variant
Dim strquery As String

Private Sub cmdEnd_Click()
End
End Sub


Private Sub Form_Load()
frmAssetbox.Left = (Screen.Width - frmAssetbox.Width) / 2
frmAssetbox.Top = (Screen.Height - frmAssetbox.Height) / 2
txtUser.Text = GetStringValue("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", "DefaultUserName")


Set conn = New ADODB.Connection
conn.Provider = "ADSDSOObject"

conn.Open "ADs Provider"

strquery = "<LDAP://directory.company.com:389/o=company>;" _
& "(uid=" & txtUser.Text & ");cn,title,mail,telephonenumber,pager,description;subtree"


Set rs = conn.Execute(strquery)

While Not rs.EOF
If IsArray(rs.Fields(0)) Then
For A = LBound(rs.Fields(0).Value) To UBound(rs.Fields(0).Value)
If rs.Fields(0).Value(A) <> "" Then
txtName.Text = rs.Fields(0)(A)
Else: txtName.Text = "No data"
End If
Next
Else
MsgBox rs.Fields(1)
End If



If IsArray(rs.Fields(1)) Then
For A = LBound(rs.Fields(1).Value) To UBound(rs.Fields(1).Value)
If rs.Fields(1).Value(A) <> "" Then
txtTitle.Text = rs.Fields(1)(A)
End If
Next
Else
txtTitle.Text = "No Data"
End If


If IsArray(rs.Fields(2)) Then
For A = LBound(rs.Fields(2).Value) To UBound(rs.Fields(2).Value)
If rs.Fields(2).Value(A) <> "" Then
txtEmail.Text = rs.Fields(2)(A)
End If
Next
Else
txtEmail.Text = "No Data"
End If


If IsArray(rs.Fields(3)) Then
For A = LBound(rs.Fields(3).Value) To UBound(rs.Fields(3).Value)
If rs.Fields(3).Value(A) <> "" Then
txtPhone.Text = rs.Fields(3)(A)
End If
Next
Else
txtPhone.Text = "No Data"
End If



If IsArray(rs.Fields(4)) Then
For A = LBound(rs.Fields(4).Value) To UBound(rs.Fields(4).Value)
If rs.Fields(4).Value(A) <> "" Then
txtPager.Text = rs.Fields(4)(A)
End If
Next
Else
txtPager.Text = "No Data"
End If

If IsArray(rs.Fields(5)) Then
For A = LBound(rs.Fields(5).Value) To UBound(rs.Fields(5).Value)
If rs.Fields(5).Value(A) <> "" Then
txtDesc.Text = rs.Fields(5)(A)
End If
Next
Else
txtDesc.Text = "No Data"
End If

rs.MoveNext
Wend


conn.Close


End Sub

I didn't see anything that will allow me to put the code into an easier format to read. Sorry.
But the code above works, but if I change the query to query our employeenumber, I get an unspecified error in VB. I check the ldap log and see an err=49. I have tried adding a username and password to see if that fixes it and get the same results. Any help would be appreciated.
dj