View Full Version : ADO CopyFromRecordset to Multi column Listbox
dvenn
02-03-2006, 05:48 PM
I currently have a CopyFromRecordset macro (I obtained here)http://www.vbaexpress.com/forum/showpost.php?p=55058&postcount=2
I need to modify this for a couple of reasons..
1. I need it to bring in header data
2. the data table has empty fields (I can not control this).
any suggestions
additonal info:
The table has 8 Columns.. I only need to bring 1-7 intot the ListBox.
_____
Further down the line.. I would like to this table using copytorecordset but will need to add to all 8 columns (the 8th column value coming from a textbox).
TIA for any assitance
XLGibbs
02-12-2006, 11:05 AM
Hi,
1. To bring in headers, set the ColumnHeads property to TRUE in the list box properties, and change the column Count to 7 in the code sample...
You can also manipulate the SQL statement to be more specific instead of Select * to identify only the columns you want.
You can also make the list box "hide" columns by setting their respective widths to zero ....
Ken Puls
02-14-2006, 01:38 PM
Hey guys,
Just happens that I'm trying to do the same thing here. I have a slightly modified version of Dennis's, but Gibbs... I can't get the column heads to come in either. Property is set to True, but it just leaves them blank.
Code used:
Dim cnt As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim rcArray As Variant
Dim strDB As String
Dim strSQL As String
' Set the string to the path of your database, and the top left cell where you want the data
strDB = "J:\VBA Tests\foodtest.mdb"
strSQL = "SELECT tblSuppliers.SupplierName, tblSuppliers.SupplierJonas " & _
"FROM tblSuppliers ORDER BY tblSuppliers.SupplierName;"
' Open connection to the database
cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strDB & ";"
' Open recordset based on Orders table
rst.Open strSQL, cnt
' Copy recordset to an array
rcArray = rst.GetRows
With Me.lbSuppliers
.ColumnCount = 2
.Clear
.List = Application.Transpose(rcArray)
.ListIndex = -1
End With
' Close ADO objects
rst.Close
cnt.Close
Set rst = Nothing
Set cnt = Nothing
Bob Phillips
02-14-2006, 03:41 PM
I believe that you only get column headings if you bind the listbox to a worksheet range, so you can't get them from a recordset/array. And I don't see where you load the field names anyway.
You can also get the listbox to hide columns by keeping the columncount to 1. You may load say 4 columns, but only one shows, but the others are still accessible.
XLGibbs
02-14-2006, 04:06 PM
Ahh, I see said the blind man, right before he walked into a wall. I didn't realize it did not work for recordsets. Doh!
footinmout
Ken Puls
02-15-2006, 10:46 AM
I believe that you only get column headings if you bind the listbox to a worksheet range, so you can't get them from a recordset/array.
Hmmm... that kind of sucks. There must be a way to do this...:think:
dvenn
02-15-2006, 01:13 PM
CopyFromRecordset doesn't return field headings.. that is the problem..
I have found a solution to that.. (unfortunately for 97)
hope this helps and maybe we can all figure this out
Sub Returning_Field_Headers_Example()
Dim db As database
Dim rs As Recordset
Dim vaTmp() As String
Dim vaNew As Variant
Dim dbLocation As String
' Opens the database and creates a record set
' dbLocation could be any directory where the Access files are
' stored.
dbLocation = "c:\access\sampapps\nwind.mdb"
' In version 97 use the sample file northwind.mdb usually located
' in c:\program files\microsoft office\office\samples\northwind.mdb
Set db = DBEngine.Workspaces(0).OpenDatabase(dbLocation)
Set rs = db.OpenRecordset("Orders")
' This section fills in the field names from the Orders table.
ReDim vaTmp(rs.Fields.Count)
For x = 0 To rs.Fields.Count - 1
vaTmp(x + 1) = rs.Fields(x).Name
Next
Sheets("Sheet1").Cells(1, 1).Resize(1, rs.Fields.Count) = vaTmp
' Retrieves the data to the sheet. The sheet should be called
' "Sheet1"
numberOfRows = Sheets("Sheet1").Cells(2, 1).CopyFromRecordset(rs)
Sheets("Sheet1").Activate
End Sub
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.