Error 3021 with Getrows VBA ADODB connection

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!

I think that error 3021 means that there are no records in the recordset. You can check this by putting MsgBox RsADODB.EOF just prior to using GetRows. If the message which pops up says True then there are no rows to get — barrowc
I think that BlaBlaTable will not be on other system. So please first check the Database. — Pallav Raj

Gareth Gareth · Accepted Answer · 2014-05-27T10:47:22

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

Error 3021 with Getrows VBA ADODB connection

1 Answers