Charlotte Foust
cfoust at infostatsystems.com
Tue Jul 22 16:22:07 CDT 2003
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
<Code Ends>
-----Original Message-----
From: David McAfee [mailto:DMcAfee at haascnc.com]
Sent: Tuesday, July 22, 2003 1:14 PM
To: 'ACCESS-L at PEACH.EASE.LSOFT.COM'
Cc: 'accessd at databaseadvisors.com'
Subject: [AccessD] using callback to fill a listbox....HELP! X-posted
I have an A2K ADP FE and a SQL 2K BE.
I have created both DAO and ADO recordsets to read the data from a "temp
db" but I cannot figure out how to assign the listbox's rowsource to
that of the recordset. I was looking at using a callback function to
fill the listbox, but that's causing my hair to fall out :(
I have the following recordset (can switch to ADO if it will be easier),
Where on earth does this go in conjunction with the call back? To I open
the recordset before initializing the callback or during? I believe that
I need to place the open recordset statement inside the acLBInitialize
Case then get the tsTmp.recordcount into a variable
Dim Tmpdb As DAO.Database, rsTmp As DAO.Recordset, intrsTmpCount AS
integer Set Tmpdb = OpenDatabase(Application.CurrentProject.Path &
"\TempRRentry.mdb")
Set rsTmp = Tmpdb.OpenRecordset("SELECT * from ""RRentry"" WHERE (ADE
<>
3")
If Not rsTmp.BOF And Not rsTmp.EOF Then
rsTmp.MoveLast
rsTmp.MoveFirst
intrsTmpCount= rsTmp.RecordCount
End If
rsTmp.Close
Set rsTmp = Nothing
Tmpdb.Close
Set Tmpdb = Nothing
Sample Callback code:
Private Function Fill_lstLI(ctrl As Control, id As Variant, row As
Variant, col As Variant, code As Variant) As Variant
Select Case code
Case acLBInitialize
' Any necessary initialization code goes here.
' For example: determine number or rows and number
' of columns, save these values in the intRows and
' intColumns variables, and re-dimension the Static array
' varDisplayData().
Dim Tmpdb As DAO.Database, rsTmp As DAO.Recordset,
intrsTmpCount As Integer
Set Tmpdb = OpenDatabase(Application.CurrentProject.Path &
"\TempRRentry.mdb") 'MDB Name was chosen in Function CreateDB
Set rsTmp = Tmpdb.OpenRecordset("SELECT * from ""RRentry""
WHERE (ADE <> 3")
If Not rsTmp.BOF And Not rsTmp.EOF Then
rsTmp.MoveLast
rsTmp.MoveFirst
intrsTmpCount = rsTmp.RecordCount
End If
rsTmp.Close
Set rsTmp = Nothing
Tmpdb.Close
Set Tmpdb = Nothing
Fill_lstLI = 1
Case acLBOpen ' Generate unique ID for control.
Fill_lstLI = 1
Case acLBGetRowCount ' Get number of rows.
Fill_lstLI = varRecords
Case acLBGetColumnCount ' Get number of rows.
Fill_lstLI = Me.lstLineItems.ColumnCount '13
Case acLBGetColumnWidth ' Column width (In twips).
' -1 forces use of default width.
Fill_lstLI = -1
Case acLBGetValue ' Get data.
Fill_lstLI = varRecords(row)
Case acLBGetFormat
Fill_lstLI = -1
Case acLBEnd
ReDim varRecords(1 To 1)
'varRecordsCount = -1
End Select
End Function
The recordset pulls back 13 columns which are in the same order as they
are displayed in the listbox from left to right. Is there anyone out
there who has dealt with these beasts that has a bit of time to help me
get this through my thick skull?
TIA
David McAfee
_______________________________________________
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com