How to assign recordset values to a two-dimensional array

Question

I'm currently working with Excel VBA and SQL queries. I'm trying to take what I've put into my recordset and dump it into a two-dimensional array, so I can use the information in a later part of the function. The issue is that I only know two methods of extracting information from recordsets: CopyFromRecordset, and rs.Fields.

Here is the code I am attempting.

Dim ID_Array(150, 2) As String
Set rs = New ADODB.Recordset
Set oConn = New ADODB.Connection

strSql = "select id, name from groups"
rs.Open strSql, oConn

Do While Not rs.EOF
    With ActiveSheet
     For Index = 0 To 171
        ID_Array(Index, 0) = CStr(rs.Fields(0).Value)

        'Safety check to make sure the value isn't null (was having problems before)
        If rs.Fields(1).Value <> Null Then
            ID_Array(Index, 1) = CStr(rs.Fields(1).Value)
        End If

    rs.MoveNext
    Next
    End With
Loop
rs.Close

I'm positive I'm not assigning these values properly, since when I go to pull them from recordset, many are either wrong or not appearing (the name portion, particularly, will not even appear as a string on a MsgBox command, so I'm assuming it's not being assigned correctly).

Anyone have any experience with this? How to do I assign the id portion of rs to ID_Array's first dimension, and the name portion of rs to ID_Array's second dimension?

Answer 1

If you use ADODB.Recordset you dont need inner loop next for.

Try use this code, should work:

Dim ID_Array() As String
Set rs = New ADODB.Recordset
Set oConn = New ADODB.Connection

strSql = "select id, name from groups"
rs.Open strSql, oConn

Index = 0
Do While Not rs.EOF
    'With ActiveSheet
     'For Index = 0 To 171 you dont need for..next, Do While Not rs.EOF show you record one by one
        ReDim Preserve ID_Array(1, Index) 
        ID_Array(0, Index) = CStr(rs.Fields(0).Value)

        'Safety check to make sure the value isn't null (was having problems before)
        If rs.Fields(1).Value <> vbNullString Then
            ID_Array(1, Index) = CStr(rs.Fields(1).Value)
        End If
    Index = Index + 1
    rs.MoveNext
    'Next
    'End With
Loop
rs.Close
End Sub

Answer 2

I see this is from a long while ago but I modified this to make it work better for me so I hop it's useful to someone else.

Function RecordSetArray(comTxt As String) As Variant
Dim ID_Array() As Variant
Dim objMyConn As ADODB.Connection, objMyCmd As ADODB.Command, rs As ADODB.Recordset
Set objMyConn = New ADODB.Connection: Set objMyCmd = New ADODB.Command: Set rs = New ADODB.Recordset

    'Open Connection'
objMyConn.ConnectionString = ConnectionString: objMyConn.Open

    'Set and Excecute SQL Command'
Set objMyCmd.ActiveConnection = objMyConn
With objMyCmd
    .CommandText = "SET NOCOUNT ON " & comTxt
    .CommandType = adCmdText: .Execute
End With
Set rs.source = objMyCmd:  rs.CursorLocation = adUseClient:      rs.Open

If rs.EOF Then
   FindRecordCount = 0
Else
   FindRecordCount = rs.RecordCount
End If

ReDim Preserve ID_Array(FindRecordCount - 1, rs.fields.count - 1)

Index = 0
Do While Not rs.EOF
    For i = 0 To rs.fields.count - 1
        ID_Array(Index, i) = rs.fields(i).Value
    Next
    Index = Index + 1
    rs.MoveNext
Loop
rs.Close: Set objMyConn = Nothing: Set objMyCmd = Nothing: Set rs = Nothing
RecordSetArray = ID_Array
End Function

Answer 3

To avoid the NULL error, update your query to include NVL function and replace with space. Trim your .Value and you should be all set. Note that replacing with blank string [''] doesn't work. Also, watch for required formatted db fields such as dates. You're replace value will error if not in matching formats.

NVL(SQL_FieldName,' ') as New_SQL_FieldName