Excel UDF从ACE SQL记录集返回数组

时间:2015-03-17 23:00:46

标签: vba excel-vba access-vba excel

我正在尝试使用ACE sql从记录集返回数组。该函数适用于表范围。

问题:如果查询返回2条或更多条记录,则该函数返回正确的记录数。但是,如果只找到一条记录,则所有行都会重复填充这一行。这是错的,但我找不到原因。

此外,我希望我的函数将从Recordset返回列名。我不知道如何将它与记录集返回的数组粘在一起。

这是代码,信用是由于我试图适应我的需求的另一个解决方案的作者:Performing SQL queries on an Excel Table within a Workbook with VBA Macro

Function SQL(dataRange As Range, CritA As String) As Variant
Application.Volatile

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim currAddress As String

currAddress = ActiveSheet.Name & "$" & dataRange.Address(False, False)

strFile = ThisWorkbook.FullName
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _
& ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cn.Open strCon


strSQL = "SELECT * FROM [" & currAddress & "]" & _
         "WHERE [A] =  '" & CritA & "'  " & _
         "ORDER BY 1 ASC"

rs.Open strSQL, cn

'SQL = rs.GetString
SQL = Application.Transpose(rs.GetRows)


Set rs = Nothing
Set cn = Nothing



End Function

1 个答案:

答案 0 :(得分:1)

如果你想要字段名,你也必须从记录集循环遍历数组:

With rs
    If Not .EOF Then
        vData = .getrows()

        ReDim vDataOut(LBound(vData, 2) To UBound(vData, 2) + 1, LBound(vData, 1) To UBound(vData, 1))
        ' get headers
        For i = 1 To .Fields.Count
            vDataOut(0, i - 1) = .Fields(i - 1).Name
        Next i
        ' Copy data
        For x = LBound(vData, 2) To UBound(vData, 2)
            For y = LBound(vData, 1) To UBound(vData, 1)
                vDataOut(x + 1, y) = vData(y, x)
            Next y
        Next x
    End If
End With

例如。

相关问题