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

Mark H Lists at theopg.com
Tue Jul 22 18:57:13 CDT 2003


Hello Charlotte 

Sorry if I'm a bit off the mark (haven't got the full thread to
backtrack)... What exactly do you mean by callback and whens its
necessary?

Below is some generic code I use for populating listboxes in Excel (not
much different from Access)... It works ok...

Sub doListBox(frm As UserForm, cmb As String, strSql As String,
arrcolformats As Variant)
' Populate a list box.
'
' Parameters:
'     frm            = The form which holds the combo box being
populated
'     cmb            = The name of the relevant list or combo box
'     strSql         = The recordsource to be used
'     arrColFormats  = A 2d array containing the column formats - Must
have
'                      a value for each column, even if hidden and they
must be
'                      in the same order as the recordsets columns.
'
On Error GoTo errBit

   Dim rs As ADODB.Recordset
   Dim rowNum As Integer
   Dim colNum As Integer
   Dim tmpArr As Variant
   
   rowNum = 0
   Set rs = New ADODB.Recordset

   rs.Open strSql, setCon, , adLockReadOnly
   
   With frm.Controls(cmb)
      .Clear
      ReDim tmpArr(UBound(arrcolformats))
      Do While Not rs.EOF
	   'FORMATTING MAY NOT BE NECESSARY IN ACCESS!!!!!!!!!!
         For colNum = 0 To UBound(arrcolformats) 'should be same as
numFields
               Select Case arrcolformats(colNum)
                  Case "Date"
                     tmpArr(colNum) = Format(rs(colNum))
                  Case "String"
                     tmpArr(colNum) = rs(colNum)
                  Case "Integer"
                     tmpArr(colNum) = CInt(rs(colNum))
                  Case "Double"
                     tmpArr(colNum) = Format(rs(colNum), "#.00")
                  Case Else
                     tmpArr(colNum) = rs(colNum)'JUST USE THIS IF
FORMATTING NOT NEEDED
               End Select
         Next
         .AddItem tmpArr(0)
         For colNum = 1 To UBound(tmpArr)
            .List(rowNum, colNum) = tmpArr(colNum)
         Next
         rowNum = rowNum + 1
         rs.MoveNext
      Loop
      rs.Close
      Erase tmpArr
   End With
   
wayout:
   rowNum = 0
   colNum = 0
   
   Set rs = Nothing
   Exit Sub

errBit:
   MsgBox Err.Description
   Resume wayout
   
End Sub

In most cases I use this, as is, to populate a list or combo box. Where
would callBack come ino it?

Mark

========================================================================
========
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



More information about the AccessD mailing list