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