[AccessD] using callback to fill a listbox....HELP! X-posted

Thanks Charlotte, that piece of code helped me out mucho! :)

I'm still playing with getting all of the rows to display. I seem to be one
short (displaying 1 less than actual recordcount). 

I also had to change the loop to work with my 13 (yes 13 :S )column
recordset:
  
    'loop through the recordset and
        'populate the array
        
        Do While Not rst.EOF
          intLoopRow = rst.AbsolutePosition
          svarArray(intLoopRow, 0) = rst(0)
          svarArray(intLoopRow, 1) = rst(1)
          svarArray(intLoopRow, 2) = rst(2)
          svarArray(intLoopRow, 3) = rst(3)
          svarArray(intLoopRow, 4) = rst(4)
          svarArray(intLoopRow, 5) = rst(5)
          svarArray(intLoopRow, 6) = rst(6)
          svarArray(intLoopRow, 7) = rst(7)
          svarArray(intLoopRow, 8) = rst(8)
          svarArray(intLoopRow, 9) = rst(9)
          svarArray(intLoopRow, 10) = rst(10)
          svarArray(intLoopRow, 11) = rst(11)
          svarArray(intLoopRow, 12) = rst(12)
          rst.MoveNext
        Loop 'While Not rst.EOF
 
But I'm way on my way, thanks again!!!

David
-----Original Message-----
From: Charlotte Foust

Here's some ADO code I wrote to populate a listbox using a callback in a
demo.

Charlotte Foust

<Code Begins>

Private Function CustomerList(ctl As Control, _
                              varID As Variant, _
                              lngRow As Long, _
                              lngCol As Long, _
                              intCode As Integer) As Variant
  'populates a combobox or listbox with a list of customers
  'set control RowSourceType to name of function to use
  ' Created by Charlotte Foust

  Dim varRetVal As Variant             'holds return value of function
  Dim intLoopRow As Integer         'holds max number of rows
  Dim cnn As ADODB.Connection   'holds connection object
  Dim rst As ADODB.Recordset      'holds recordset object
  Static svarArray() As Variant      'holds data from recordset
  Static sintRows As Integer          'holds record count of recordset
  Static sintCols As Integer            'holds fields count of recordset

  On Error GoTo Proc_err

  'return values based on column being called
  Select Case intCode

    'initialize the row on call 0
    Case acLBInitialize
      On Error Resume Next
      intLoopRow = UBound(svarArray)
      If Err <> 0 Then
        On Error GoTo Proc_err
        'populate the customer recordset
        Set cnn = New ADODB.Connection
        With cnn
          .Provider = "Microsoft.Jet.OLEDB.4.0"
          'this gets stored values from the only
          'local table to allow flexibility
          .ConnectionString = CurrentProject.Path & "\NoTablesData.mdb"
          .Open
        End With 'cnn
        Set rst = New ADODB.Recordset
        With rst
          .ActiveConnection = cnn
          .Source = "SELECT C.CustomerID, C.CompanyName " _
              & "FROM tblCustomers AS C " _
              & "WHERE C.CustomerID Is Not Null " _
              & "ORDER BY C.CompanyName, C.CustomerID"
          .CursorLocation = adUseClient
          .CursorType = adOpenDynamic
          .LockType = adLockReadOnly
          .Open , , , , adCmdText
          .MoveLast
          sintRows = .RecordCount
          .MoveFirst
          sintCols = .Fields.Count
        End With 'rst

        'disconnect the recordset
        Set cnn = Nothing

       'redim the array to hold the recordset data
        ReDim svarArray(sintRows, sintCols)

        'loop through the recordset and 
        'populate the array
        Do While Not rst.EOF
          intLoopRow = rst.AbsolutePosition
          svarArray(intLoopRow, 0) = rst(0)
          svarArray(intLoopRow, 1) = rst(1)
          rst.MoveNext
        Loop 'While Not rst.EOF

        'close the recordset
        rst.Close
    End If 'Err <> 0  

    'return a true value of the calling routine
     varRetVal = True
      
    Case acLBOpen ' call 1
      'return a unique ID code
      varRetVal = Timer

    Case acLBGetRowCount 'call 3
      ' Return number of rows
      varRetVal = sintRows
      
    Case acLBGetColumnCount 'call 4
      ' Return number of fields (columns)
      varRetVal = sintCols

    Case acLBGetColumnWidth 'call 5
      'return the column widths or
      '-1 for the default width for the column
     ' varRetVal = -1 'default width
      Select Case lngCol
        Case 0
         'hide the first column
         varRetVal = 0
       Case 1
          'return the default width for column 2
          varRetVal = -1
      End Select 'Case lngCol

    Case acLBGetValue 'call 6
      'Return actual data
      varRetVal = svarArray(lngRow, lngCol)
      If lngRow = 0 Then
        varRetVal = Null
      End If ' lngRow = 0
    Case acLBGetFormat 'call 7
      'return the formatting info for the row/column
      Select Case lngCol
        Case 0
          'handle each column, setting the format.
        Case 1
      End Select 'Case lngCol
      
    Case acLBEnd 'call 9
      'clean up
      On Error Resume Next
      'clear the array
      Erase svarArray

      'destroy the object variables
      Set rst = Nothing
      Set cnn = Nothing
  End Select 'Case intCode

Proc_exit:
  On Error Resume Next
  'return the value to the calling routine
  CustomerList = varRetVal
Exit Function

Proc_err:
  'MsgBox Err.Number & "--" & Err.Description & vbCrLf & "CustomerList"
  varRetVal = False
  Resume Proc_exit
End Function 'CustomerList(ctl As Control, _
                              varID As Variant, _
                              lngRow As Long, _
                              lngCol As Long, _
                              intCode As Integer) As Variant
-------------- next part --------------
A non-text attachment was scrubbed...
Name: not available
Type: application/ms-tnef
Size: 4241 bytes
Desc: not available
URL: <http://databaseadvisors.com/pipermail/accessd/attachments/20030722/6d7b8918/attachment-0001.bin>