CODEWITHSUNDEEP
mysqlvbaodbc
harryg
harryg

Reputation: 24077

Populating VBA array with results of ODBC sql query

I am using VBA to query a MySQL database. This involves the use of the ODBC driver which I have up and running great.

I want to return the results of my query in a VBA multidimensional array. (columns for fields, rows for records)

There is a known problem with the ODBC MySQL driver in VBA in that the property .RecordCount evaluates to -1 rather than the actual number of records upon success. This means that I can't use it to size my array before looping through .EOF to extract the records.

I have tried this:

If Rs.RecordCount <> 0 Then //Just check if it's not false as recordcount is not fully functional
        Fields = Rs.Fields.Count //This actually works
        rw = 1
        Dim result()
        Do Until Rs.EOF
            ReDim Preserve result(1 To rw, 1 To Fields)
            C = 1
            For Each MyField In Rs.Fields
                result(rw, C) = MyField
                C = C + 1
            Next MyField
            Rs.MoveNext
            rw = rw + 1
        Loop
        get_result = result //Output the result
End if

But I get an error 9: subscript out of range. This is driving me nuts, in php this would be trivial but for some reason I can't figure this out in VBA. Any ideas?

Upvotes: 1

Views: 2636

Answers (2)

Robert Todar
Robert Todar

Reputation: 2145

I needed a way to return the heading fields with my data since Rs.GetRowsonly includes the row data. I created a function to help with this and thought it would be helpful to add it to this old post in case someone else has the same need.

'RETURNS A TWO-DIM ARRAY FROM A RECORDSET WITH OPTION TO INCLUDE HEADERS
Public Function ArrayFromRecordset(ByVal Rs As Object, Optional ByVal IncludeHeaders As Boolean = True) As Variant

    '@author Robert Todar <[email protected]>

    'CHECK TO MAKE SURE THERE ARE RECORDS TO PULL FROM
    If Rs.BOF Or Rs.EOF Then
        Exit Function
    End If

    'SIMPLY RETURN DATA IF HEADERS NOT INCLUDED
    If IncludeHeaders = False Then
        ArrayFromRecordset = Rs.getrows
        Exit Function
    End If

    'STORE RS DATA IN VARIABLE
    Dim RsData As Variant
    RsData = Rs.getrows

    'TEMP ARRAY WILL USE THIS TO ACCOUNT FOR THE HEADING ROW
    Const HeadingIncrement As Integer = 1

    'REDIM TEMP TO ALLOW FOR HEADINGS AS WELL AS DATA
    Dim Temp As Variant
    ReDim Temp(LBound(RsData, 2) To UBound(RsData, 2) + HeadingIncrement, LBound(RsData, 1) To UBound(RsData, 1))

    'ADD HEADERS TO ARRAY
    Dim HeaderIndex As Long
    For HeaderIndex = 0 To Rs.Fields.Count - 1
        Temp(LBound(Temp, 1), HeaderIndex) = Rs.Fields(HeaderIndex).Name
    Next HeaderIndex

    'ADD DATA TO ARRAY
    Dim RowIndex As Long
    For RowIndex = LBound(Temp, 1) + HeadingIncrement To UBound(Temp, 1)

        Dim ColIndex As Long
        For ColIndex = LBound(Temp, 2) To UBound(Temp, 2)
            Temp(RowIndex, ColIndex) = RsData(ColIndex, RowIndex - HeadingIncrement)
        Next ColIndex

    Next RowIndex

    'RETURN
    ArrayFromRecordset = Temp

End Function

Upvotes: 1

harryg
harryg

Reputation: 24077

OK, wow, it seems all I needs to do is use .getRows

So my code becomes:

If Rs.RecordCount <> 0 Then 
        get_result = Rs.getRows 
End if

Upvotes: 1

Related Questions