错误3021与Getrows VBA ADODB连接
您好我试图编写一个文件从SQL获取数据到VBA中的数组。
首先，我试图使用这个代码，并与我的电脑，但在其他用户的计算机中testing文件后，我发现错误types2146825287当macros到它打开连接的地方。 我不是IT部门的一员，所以我将无法更新用户的服务包，所以我试着重新使用其他用户在另一个文件工作的另一个代码几年前的另一个文件。
这是我的第一个问题：
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
我试图修改这个代码来使用它，就像我的第一个aproach将recorset保存到一个数组。 现在我可以打开连接并打开logging集，但是我不能使用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
有没有其他select来填充数组而不使用GetRows方法？ 你有这个代码连接的一些替代品吗？
在此先感谢您的帮助！
尝试下面的代码。 如果没有logging返回，数组将是空的，你需要检查。
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