sorry for the simple question but I am still a novice of VBA and Access.
I am trying to run a query in Access, then I need to import the output of this query to a listbox which has been created using Excel. The lisbox will have several columns (less than 10).
This is the code I am running:
'Set the name of the query you want to run and retrieve the data
Query = "SELECT [05_REQUESTED_ITEM].Manufacturer, [05_REQUESTED_ITEM].Quantity, [05_REQUESTED_ITEM].Description, [05_REQUESTED_ITEM].Application, [06_ITEM_DETAILS].Item, [06_ITEM_DETAILS].MAT_RFQ, [06_ITEM_DETAILS].Dimensions, [06_ITEM_DETAILS].Component, [06_ITEM_DETAILS].Part FROM (01_INPUT_DATA LEFT JOIN 05_REQUESTED_ITEM ON [01_INPUT_DATA].[SPET_ID] = [05_REQUESTED_ITEM].[SPET_ID]) LEFT JOIN 06_ITEM_DETAILS ON [01_INPUT_DATA].[SPET_ID] = [06_ITEM_DETAILS].[SPET_ID] WHERE ((([01_INPUT_DATA].SPET_ID)='" & ID & "'));"
On Error Resume Next
'Create the ADODB recordset object
Set rs = New ADODB.Recordset
'Check if the object was created.
If Err.Number <> 0 Then
'Error! Release the objects and exit
Set rs = Nothing
Set cnt = Nothing
'Display an error message to the user
MsgBox "Recordset was not created!", vbCritical, "Recordset Error"
Exit Function
End If
On Error Resume Next 'GOTO 0
'Set the cursor location and type, the lock type and the options
rs.CursorLocation = 2 ' = adUseServer '3 = adUseClient on early binding
rs.CursorType = 2 ' = adOpenDynamic '1 = adOpenKeyset on early binding
'Open the recordset
rs.Open Source:=Query, _
ActiveConnection:=cnt
'Check if the recordset is empty
If rs.EOF And rs.BOF Then
MsgBox "hello", vbOKOnly
'Release the object
Set rs = Nothing
Else
'Explore the recordset
rs.MoveFirst
'ReadData = rs.GetRows
With SEARCH_TOOL.SA_Result_Item_ListBox
.Clear
.ColumnCount = rs.Fields.Count
For i = 0 To .ColumnCount
ReadData = rs.GetRows(i)
.List(i) = Application.WorksheetFunction.Transpose(ReadData)
Next i
End With
End If
What I find very strange is the fact that a very similar code is working when I populate the listbox with a query which has only one column of result as output.
How can I adapt my code to display in the listbox the full output divided in columns?
Thank you in advance for your time and support!
You can think of the List
-property of a listbox as a 2-dimensional array. There are different ways to fill it:
AddItem
to create a new "row" in that array. After that, you can write into the single elements of that row - but you need to create it the row first.In your case, the first method is easier. You can get all data of the recordset into an 2-dimensional array with the method rs.GetRows
(you have the statement already in your code, but you have commented it out).
Unfortunately, the dimensions of that array are "wrong": The first dimension is the field, the second is the row (both dimensions are 0-based). ReadData(0, 3)
is the value of the first field of the 4th row. The List
expects the data vice versa (row in first dimension, fields in second). Therefore, you need to transpose the data:
Dim readData As Variant
readData = rs.GetRows
With SEARCH_TOOL.SA_Result_Item_ListBox
.Clear
.ColumnCount = rs.Fields.Count
.List = WorksheetFunction.Transpose(readData)
End With
Now there is only one problem: If your data may contain null-Values, WorksheetFunction.Transpose
will throw an error. In that case I recommend to write a small helper function to do your transpose the data. I had issues with the data type Decimal
, so I added an extra check for that.
Function myTranspose(data As Variant) As Variant
ReDim transposedData(LBound(data, 2) To UBound(data, 2), LBound(data, 1) To UBound(data, 1))
Dim i As Long, j As Long
For i = LBound(data, 1) To UBound(data, 1)
For j = LBound(data, 2) To UBound(data, 2)
If IsNull(data(i, j)) Then
transposedData(j, i) = vbNullString
ElseIf VarType(data(i, j)) = vbDecimal Then
transposedData(j, i) = CLng(data(i, j))
Else
transposedData(j, i) = data(i, j)
End If
Next j
Next i
myTranspose = transposedData
End Function
Then, your code could look like this instead
.Clear
.ColumnCount = rs.Fields.Count
.List = myTranspose(readData)