Question

我正在尝试使用ADO在VBA中构建一个函数，该函数将在SQL中运行查询并返回表中的记录数。查询是：

SELECT COUNT(ID) FROM Queue

在SQL Server中，此查询运行正常并返回非null值。我构建的函数运行SQL查询，将输出和标题存储到数组，并返回该数组，以便我的代码的其他部分可以使用它。在SQLstr =“SELECT * FROM Queue”的情况下运行它没有问题，但出于某种原因，当我尝试使用像COUNT（）这样的聚合函数时，它会中断。

它中断的原因是RecSet.RecordCount返回-1并且显然你不能创建-1长度的数组，因此ReDim Results（dim_x，dim_y）抛出“下标超出范围”错误。

我已经尝试更改游标类型和锁定类型（游标当前是静态的）无济于事。我可以使用.copyFromRecordSet方法将记录集复制到Excel，所以我知道数据正确地通过，但我需要数组中的数据，我觉得这是一个伪劣的解决方法，只需转入Excel并将其复制回来变成一个变量。有任何想法吗？该功能的代码如下：

Function ExecSql(Server as string, DB as string, SQLstr as string)
    Dim Results As Variant
    Dim temp As Variant
    Dim x As Integer
    Dim y As Integer
    Dim dim_x As Integer
    Dim dim_y As Integer

    Dim Conn As Object
    Dim RecSet As Object
    Set Conn = CreateObject("ADODB.connection")
    Set RecSet = CreateObject("ADODB.RecordSet")

    With Conn
        .ConnectionString = "Provider=SQLOLEDB;Server=" & ServerName & ";Database=" & dbName & ";Trusted_Connection=yes;"
        .Open
    End With
            If Conn.State = 1 Then
                With RecSet
                    .ActiveConnection = Conn
                    .Source = SQLstr
                    .LockType = 3
                    .CursorType = 3
                    .Open
                End With
            Else:
                Conn.Close
                ExecSql = "Connection Failed"
                Exit Function
            End If


            dim_x = RecSet.Fields.count - 1 'counts total fields at index 0, hence subtract 1
            dim_y = RecSet.RecordCount 'add one extra row for headers, i.e. don't subtract 1

            Results = Array()
            temp = Array()
            ReDim Results(dim_x, dim_y)

            'Add headers to array
            For x = 0 To dim_x 'array and recset both start at index 0
                Results(x, 0) = RecSet.Fields(x).Name
            Next x

            'retrieve data
            y = 2
        With RecSet
            If Not .bof And Not .EOF Then
                .movelast
                .movefirst
                temp = .GetRows(dim_y)
            Else
            End If
            .Close
        End With

        'Add data to array
        For y = 1 To dim_y 'start at y = 1, y = 0 is headers
            For x = 0 To dim_x
                Results(x, y) = temp(x, y - 1)
                Debug.Print Results(x, 0) & " - " & temp(x, y - 1)
            Next x
        Next y

        If IsNull(Results) Then
            ExecSql = 0
        Else
            ExecSql = Results
        End If
End Function

ADO中的SQL聚合函数返回-1记录

0 个答案: