Populating multi-column listbox with Access data

[nuvolari]

I'm trying to populate a multi-column listbox with data from Access. The problem is that if the database only has 1 record, it will display each field of the record as a different listbox item.

E.g

Dave
Smith
12/04/1955

instead of "Dave Smith 12/04/1955" as a single listbox item.

[vba]
'Global constants required
Const glob_sdbPath = "C:\test.mdb"
Const glob_sConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & glob_sdbPath & ";"

Dim cnt As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim rcArray As Variant
Dim sSQL As String

'Set the location of your database, the connection string and the SQL query
sSQL = "SELECT tblPerson.FirstName, tblPerson.LastName, tblPerson.DateOfBirth " & _
"FROM tblPerson;"

'Open connection to the database
cnt.Open glob_sConnect

'Open recordset and copy to an array
rst.Open sSQL, cnt
rcArray = rst.GetRows

'Place data in the listbox
With Me.lbSuppliers
.Clear
.ColumnCount = 3
.List = Application.Transpose(rcArray)
.ListIndex = -1
End With

'Close ADO objects
rst.Close
cnt.Close
Set rst = Nothing
Set cnt = Nothing

End Sub

[/vba]
Any help would be appreciated. Thanks

[Kenneth Hobs]

Have you tried dropping the Application.Transpose?

[nuvolari]

I have tried that. It produces the same result.

[Kenneth Hobs]

Not sure why your Transpose worked.

This example is easily tested by adding the path and name to Northwind.mdb or NWind.mdb as I named it. Add a ListBox1 to a UserForm. Uncomment the 2nd sSQL to view all of the Orders records if you don't want to view just the 1 record.

I would just iterate the whole recordset and build the array. In this example, you can change the path and name to point to the NorthWind database to test. I included the fieldnames as Index 0 for the listbox.

[VBA]Option Explicit
'Global constants required
Const glob_sdbPath = "u:\Material\ADO\NWind.mdb"
Const glob_sConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & glob_sdbPath & ";"

Private Sub UserForm_Initialize()
'Requires Reference to Microsoft ActiveX Data Objects 2.8 Library
Dim cnt As ADODB.Connection
Dim rst As ADODB.Recordset
Dim rcArray() As Variant
Dim sSQL As String
Dim row As Long, col As Long

'Set the location of your database, the connection string and the SQL query
sSQL = "SELECT * FROM Orders "
sSQL = sSQL & "WHERE OrderID = 10272"

'Open connection to the database
Set cnt = New ADODB.Connection
cnt.Open glob_sConnect

'Open recordset
Set rst = New ADODB.Recordset
' Record locking
rst.CursorType = adOpenKeyset
rst.LockType = adLockOptimistic
rst.Open sSQL, cnt

With rst
'Fill Array
.MoveFirst
row = .RecordCount
col = .Fields.Count - 1
If row < 1 Then GoTo endnow
ReDim rcArray(0 To row, 0 To col)
'Write the field names
For col = 0 To .Fields.Count - 1
rcArray(0, col) = .Fields(col).Name
Next col
.MoveFirst
'Write the recordset
For row = 0 To .RecordCount
For col = 0 To .Fields.Count - 1
rcArray(row + 1, col) = .Fields(col).Value
Next col
If row = rst.RecordCount - 1 Then
Exit For
Else: .MoveNext
End If
Next row
End With

'Place data in the listbox
With ListBox1
'.Clear
.ColumnCount = 3
.List = rcArray
.ListIndex = 1
End With

'Close ADO objects
endnow:
rst.Close
cnt.Close
Set rst = Nothing
Set cnt = Nothing
End Sub
[/VBA]

[nuvolari]

Thanks for your help. Just one more question. How do I make fieldnames have a bold font?

[Kenneth Hobs]

For that scenario, I would probably show a one line Listbox and set the Font to bold and fill it with the fieldnames. In the other, just fill it with the record data. Size and align them and it will look ok I think.

Alternatively, you could us a Label control but alignment might need some tweaking.

[nuvolari]

Thanks again.