使用ADO Recordset填充列表框

Question

Below is my Code for POpulating ListBox using ADO Recordset . It is working but not in a way it should be display in form.

   Function PopulatelstReview()
    Dim sList As String
    Dim i As Long
    Dim ADORs As ADODB.Recordset
    Dim strSearchResult As String
    Set AdoCn = New ADODB.Connection

    Set AdoCmd = New ADODB.Command

    AdoCn.Open AdoConnectionString

    AdoCmd.ActiveConnection = AdoConnectionString
    Debug.Print AdoConnectionString

    Set ADORs = New ADODB.Recordset
    'rs.Open "TestListReview", AdoCn
    ADORs.CursorLocation = adUseClient
    'rs.Open strSQL, AdoConnectionString, adOpenDynamic, adLockOptimistic, adCmdText


        AdoCmd.CommandType = adCmdStoredProc
        AdoCmd.CommandText = "TestListReview"
       Set rs = AdoCmd.Execute
    Set ADORs = ExecuteStoredProcedure("TestListReview", AdoCmd)

    With ADORs
    lstReview.RowSourceType = "Value List"
          lstReview.ColumnHeads = False

              Label43.Caption = ADORs.Fields(0).Name
         Label44.Caption = ADORs.Fields(1).Name
           Label45.Caption = ADORs.Fields(2).Name
            Label48.Caption = ADORs.Fields(3).Name
             Label49.Caption = ADORs.Fields(4).Name
              Label50.Caption = ADORs.Fields(5).Name
               Label51.Caption = ADORs.Fields(6).Name
               Label52.Caption = ADORs.Fields(7).Name

                lstReview.AddItem ADORs!id
                lstReview.AddItem ADORs!TradePartner
                lstReview.AddItem ADORs!TrustAccount
                lstReview.AddItem ADORs!Date
                lstReview.AddItem ADORs!CurrentBalance
                lstReview.AddItem ADORs!FileName
                lstReview.AddItem ADORs!RecordNum
                lstReview.AddItem ADORs!ImportDateTime

                 sList = ADORs.GetString(adClipString, , ";", ";")
            'lstReview.RowSourceType = "Value List"
            'lstReview.RowSource = sList
      End With
    'Call RS2WS(ADORs, "A3")
    'lstReview.Column(0, 1) = "ID"

    End Function

I need that each value should come under appropiate columns which i placed in labels.please tell me how can i do this

Answer 1

Are you using Excel or Access? if you are using Access you could import/linked table and use normal queries as (recordsource) to populate list boxes.

anyhow, here is a pseudo code to populate a listbox using your method. After you have connected to the server and executed your SQL statement try following codes.

Dim RC, CC As Long
ADORs.MoveLast ' vba will not know the total row until you scroll down to the last
RC = ADORs.RecordCount ' get the result row count
CC = ADORs.Fields.count ' get the field/column count
ADORs.MoveFirst ' Move back to the first record

lstReview.ColumnHeads = True
lstReview.ColumnCount = CC ' Number of column as in the recordset

'Fill the column names
Dim I As Integer
For I = 0 To CC - 1
    lstReview.Column(I, 0).value = ADORs.Fields(I).name
Next I


'Fill the data
Dim J As Integer
While Not ADORs.EOF
    For I = 1 To RC - 1
        For J = 0 To CC - 1
            lstReview.Column(J, I).value = ADORs.Fields(J).value
        Next J
    Next I
    ADORs.MoveNext 'moving to next record
Wend

Also you should consider trapping errors such as if the SQL execution has returned any records.

for access you can use this

If Nz(ADORs.RecordCount, 0) = 0 Then
        MsgBox "Sorry no records found.."
        Exit Sub
    End If

if you are using excel you can use something like this

If isNull(ADORs.RecordCount) or (ADORs.RecordCount = 0) Then
    MsgBox "Sorry no records found.."
    Exit Sub
End If

hope this helps.. enjoy :)