Question

您好我正在尝试编写一个文件来将数据从SQL获取到VBA中的数组。

首先，我尝试使用此代码并使用我的计算机，但在其他用户计算机上测试该文件后，当宏到达打开连接的位置时，我发现错误类型-2146825287。我不是IT部门的一员，所以我将无法更新用户Service Pack，所以我尝试重用其他用户在几年前为另一个文件工作的另一个代码。

这是我的第一个方法：

Function ConsultaQueryADODB(ConexionString, Query) As Variant
Dim CnADODB As ADODB.Connection
Set CnADODB = New ADODB.Connection
CnADODB.ConnectionString = ConexionString
CnADODB.Open

Dim RsADODB As ADODB.Recordset
Set RsADODB = New ADODB.Recordset

/// Open RecordSet
Set RsADODB = CnADODB.Execute(Query)

///Keep the Recordset using an Array
Dim ArrayQuery As Variant
ArrayQuery = RsADODB.GetRows

RsADODB.Close
Set RsADODB = Nothing
ConsultaQueryADODB = ArrayQuery

End Function

在我发现的旧文件中，程序员能够连接到数据库，并且可以在其他用户计算机上运行。这是他的代码：

Public Sub QueryBrand()
Dim cn As Object

Set cn = CreateObject("ADODB.Connection")
cn.ConnectionString = "driver={SQL Server};server=SERVERNAME;database=BDInfo;uid=Hello;pwd=Hi"

Dim rst As Object
        cn.Open

Set rst = CreateObject("ADODB.Recordset")                    
Sql = "SELECT distinct Brand FROM BlablaTable order by Brand"
rst.Open Sql, cn, 1, 3
    c = 0
    f = 2
Sheets("Sheet1").Activate
Range("B2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents

Do While Not rst.EOF
Hoja2.Cells(f, 2) = rst.Fields("Marca")
    f = f + 1
rst.MoveNext
Loop
On Error Resume Next
rst.Close
cn.Close
Set cn = Nothing
Set rst = Nothing
End Sub

我尝试修改此代码以使用它，就像我的第一个方法一样，将recorset保存到数组中。现在我可以打开连接并打开记录集，但是我无法使用GetRows方法，因为它变成了错误3021.再次在我的计算机中运行良好，但是当我在另一台计算机上运行它时犯规。这是我的第二个方法：

Function ConsultaQueryADODB(ConexionString, Query) As Variant

Set CnADODB = CreateObject("ADODB.Connection")
CnADODB.ConnectionString = ConexionString

Dim RsADODB  As Object
CnADODB.Open
Set RsADODB = CreateObject("ADODB.Recordset")
'/// Open the RecordSet
RsADODB.Open Query, CnADODB
'///Save the recordset into an array
Dim ArrayQuery As Variant
ArrayQuery = RsADODB.GetRows '----HERE APPEARS AN ERROR 3021 in the others computers

RsADODB.Close
Set RsADODB = Nothing
ConsultaQueryADODB = ArrayQuery
CnADODB.Close
Set CnADODB = Nothing
End Function

有没有替代方法可以在不使用GetRows方法的情况下填充数组？你有这个代码连接的替代方案吗？

提前感谢您的帮助！

Answer 1

请尝试以下代码。如果没有返回记录，则数组将为空，您需要检查它。

Function ConsultaQueryADODB(ConexionString, Query) As Variant()

Set CnADODB = CreateObject("ADODB.Connection")
CnADODB.ConnectionString = ConexionString

Dim RsADODB  As Object
CnADODB.Open
Set RsADODB = CreateObject("ADODB.Recordset")
'/// Open the RecordSet
RsADODB.Open Query, CnADODB
'///Save the recordset into an array
If Not RsADODB.BOF And Not RsADODB.EOF Then
    ConsultaQueryADODB = RsADODB.GetRows()
End If

RsADODB.Close
Set RsADODB = Nothing
CnADODB.Close
Set CnADODB = Nothing

End Function

使用Getrows VBA ADODB连接时出现错误3021

1 个答案: