Query Examples Using ADO

The following code shows how to connect to a directory service, access an ADSI provider, and query an object.

Dim QuerySTring As String
Dim MyConnection As New Connection
Dim MyRecordset As Recordset
Dim i As Integer
Dim Msg As String
Dim vRecsAffected As Variant
Dim liTemp As ListItem
 
On Error GoTo errhand
 
' Ask for and get credentials if necessary.
 
If (fLogin.mylogin) Then
    
    FormQuery.MousePointer = vbHourglass
    ' Set the query string
    QuerySTring = sDn + ";" + sQuery + ";" + sReturnAttributes
    ' Add adspath to the return string.
    QuerySTring = QuerySTring + ",adspath"
    ' Add the scope
    If iScope = SCOPEBASE Then
        QuerySTring = QuerySTring + ";Base"
    ElseIf iScope = SCOPE1LVL Then
        QuerySTring = QuerySTring + ";OneLevel"
    ElseIf iScope = SCOPESUBTREE Then
        QuerySTring = QuerySTring + ";SubTree"
    Else
        MsgBox "internal err"
    End If
    
    ' Set the connection object props
    MyConnection.Provider = "ADsDSOObject"
    MyConnection.Open "ADs Provider", szUserName, szPassword
    Set MyRecordset = MyConnection.Execute(QuerySTring, vRecsAffected, adCmdUnspecified)
    ' Prepare listview
    FormQuery.ListView1.ColumnHeaders.Clear
    FormQuery.ListView1.ListItems.Clear
    ' Put in listview column headers for the number of attributes.
    
    For i = 0 To MyRecordset.Fields.Count - 1
        FormQuery.ListView1.ColumnHeaders.Add , , CStr(MyRecordset.Fields(i).name), _
         (FormQuery.ListView1.Width / MyRecordset.Fields.Count)
    Next i
    
    ' Loop through each row returned and display.
    While Not MyRecordset.EOF
        For i = 0 To MyRecordset.Fields.Count - 1
            On Error GoTo NOHANDLE
            DoEvents                'Handle events
            If i = 0 Then
                ' Add main column item to list view.
                If Not IsNull(MyRecordset.Fields(i)) Then sString = CStr(MyRecordset.Fields(i)) Else sString = "Null"
                Set liTemp = FormQuery.ListView1.ListItems.Add(, , sString)
            Else
                If Not (IsEmpty(MyRecordset.Fields(i))) Then
                    If Not (IsNull(MyRecordset.Fields(i))) Then sString = CStr(MyRecordset.Fields(i)) Else sString = "Null"
                    liTemp.SubItems(i) = sString
                End If
                
                On Error GoTo errhand
           End If
        Next i
        iQueryAdsPathArrayIndex = i
        sString = ""
        
        MyRecordset.MoveNext
    Wend
    
    FormQuery.MousePointer = Default
    If FormQuery.ListView1.ListItems.Count = 0 Then MsgBox "No records returned"
    
End If