使用ODBC sql查询的结果填充VBA数组

时间:2013-10-01 08:54:06

标签: mysql vba odbc

我正在使用VBA查询MySQL数据库。这涉及使用我已经运行良好的ODBC驱动程序。

我想在VBA多维数组中返回查询结果。 (字段列,记录行)

VBA中的ODBC MySQL驱动程序存在一个已知问题,即属性.RecordCount的值为-1,而不是成功时的实际记录数。这意味着在循环遍历.EOF以提取记录之前,我无法使用它来调整数组的大小。

我试过这个:

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

但我得到一个错误9:下标超出范围。 这让我疯了,在php中这将是微不足道的但由于某种原因我无法在VBA中弄清楚这一点。有什么想法吗?

2 个答案:

答案 0 :(得分:0)

好的,哇,好像我需要做的就是使用.getRows

所以我的代码变成了:

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

答案 1 :(得分:0)

我需要一种方法来返回标题字段和我的数据,因为Rs.GetRows仅包含行数据。我创建了一个函数来帮助解决此问题,并认为将其添加到此旧帖子中会很有帮助,以防其他人有同样的需求。

'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 <robert@roberttodar.com>

    '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