CODEWITHSUNDEEP
sqlexcelvbams-access
busynessman
busynessman

Reputation: 19

Import recordset from Access to Excel ListBox

I am trying to run a query in Access, then to import the output to a listbox which has been created using Excel. The lisbox will have several columns (less than 10).

'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

Similar code populates the listbox with a query which has only one column as output.

How can I adapt my code to display in the listbox the full output divided in columns?

Upvotes: 0

Views: 104

Answers (1)

FunThomas
FunThomas

Reputation: 29586

You can think of the List-property of a listbox as a 2-dimensional array. There are different ways to fill it:

  • Assign a 2-dimensional array.
  • Use 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)

Upvotes: 4

Related Questions