Error 3021 with Getrows VBA ADODB connection - vba

Question

Hi I'm trying to program a file to get data from SQL to an array in VBA.
First I tried to use this code and worked with my computer, but after testing the file in other users computer I found the error type-2146825287 when the macro got to the place where it opens the connection. I'm not part of IT department so I will not be able to update the users Service Packs so I tried to reuse another code made by other user that worked for another file some years ago.
This was my first aproach:
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
In the old file I found, the programmer was able to connect to the DB and it worked in other users computers. This was his code:
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
I tried to modify this code to use it like my first aproach to save the recorset to an array. Now I'm able to open the connection and to open the recordset, but I'm not able to use the GetRows Method cause it becomes an Error 3021. Again in my computer it runs well, but when I run it in another computer it doesnt.
This is my second aproach:
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
Is there any alternative to populate an array without using the GetRows Method? Do you have some alternatives for this code o connection?
Thanks in advance for your help!

Answer 1

Try the following code below. If not records are returned, the array will be empty which you'll need to check.
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