'********************************************************************************************************** ' Name: getRecordsetAsArray ' Author: mielk | 2012-09-15 ' ' Comment: Function fetches the data based on the given SQL string and using the given ' connection and returns them as a two-dimensional array. ' ' Parameters: ' connection Connection used to communicate with the database. ' It must be object of ADODB.Connection class, otherwise error will be thrown. ' sqlString SQL command used for fetching data. ' includeHeaders Determines if the results array should contain headers row. ' * By default headers row is included in the result array. ' ' ' Returns: ' Variant Array representing recordset returned by the query given ' as a parameter. ' ' ' Exceptions: ' ConnectionException Thrown if the given parameter [connection] is not of ADODB.Connection ' class or if it is closed. ' SQLException Thrown if the given SQL query could not been executed for any reason. ' ' ' --- Changes log ----------------------------------------------------------------------------------------- ' 2012-09-15 mielk Class created. '********************************************************************************************************** Public Function getRecordsetAsArray(connection As Object, sqlString As String, _ Optional includeHeaders As Boolean = False) As Variant Const METHOD_NAME As String = "getRecordsetAsArray" '------------------------------------------------------------------------------------------------------ 'This value is used for rediming result array. Const REDIM_STEP As Long = 1000 '------------------------------------------------------------------------------------------------------ Dim results() As Variant Dim rs As ADODB.Recordset Dim fld As ADODB.Field Dim row As Long Dim column As Integer Dim columns As Integer '------------------------------------------------------------------------------------------------------ 'Check if the given connection is defined and open. -------------------------------------------------| If Not TypeOf connection Is ADODB.connection Then GoTo ConnectionException '| If connection Is Nothing Then GoTo ConnectionException '| If connection.State = 0 Then GoTo ConnectionException '| '----------------------------------------------------------------------------------------------------| 'Try to get the recordset based on the SQL query given as an input parameter. If any error ----------| 'occur, code moves to the SQLException label and throw an exception. '| On Error GoTo SQLException '| Set rs = connection.execute(sqlString) '| On Error GoTo 0 '| '----------------------------------------------------------------------------------------------------| 'Resize results array to have as many columns as fields in recordset [rs]. --------------------------| columns = rs.fields.Count '| '| 'For resizing array rows, constant REDIM_STEP is used. At this point it is not possible to quickly '| 'check how many records is stored in the recordset obtained above. '| 'Result array could be resized by one row for each record, but since array resizing is '| 'time-consuming operation this would impact performance of the function. This is why array is '| 'resized each time by more rows at the same time (defined in REDIM_STEP constant) and all the '| 'unused rows are removed at the end of the function. '| ReDim results(1 To columns, 1 To REDIM_STEP) '| '----------------------------------------------------------------------------------------------------| 'Assign column headers if [includeHeaders] parameters is set to True. -------------------------------| If includeHeaders Then '| row = 1 '| '| '--------------------------------------------------------------------------------------------| '| For Each fld In rs.fields '| '| column = column + 1 '| '| results(column, 1) = fld.name '| '| Next fld '| '| '--------------------------------------------------------------------------------------------| '| '| End If '| '----------------------------------------------------------------------------------------------------| 'Iterate through the recordset above earlier and put all the data into the result array. ------------| Do Until rs.EOF '| '| row = row + 1 '| '| 'Check if there is enough space in the result array for adding new entry. If not, -----------| '| 'add another set of rows. '| '| If row > UBound(results, 2) Then '| '| ReDim Preserve results(1 To columns, LBound(results, 2) To UBound(results, 2) + _ REDIM_STEP) '| '| End If '| '| '--------------------------------------------------------------------------------------------| '| '| '| 'Iterate through all the columns and put the values into the array. -------------------------| '| For column = 1 To columns '| '| '| '| 'Fields in recordset are indexed from 0, that is why we refer to [column - 1] index. '| '| results(column, row) = rs.fields(column - 1).value '| '| '| '| Next column '| '| '--------------------------------------------------------------------------------------------| '| '| 'Move to the next record. '| Call rs.MoveNext '| '| Loop '| '----------------------------------------------------------------------------------------------------| 'Remove unused rows from the result array (or completely erase result array if no records have ------| 'been returned in the recordset). '| If row Then '| ReDim Preserve results(1 To columns, 1 To row) '| Else '| Erase results '| End If '| '----------------------------------------------------------------------------------------------------| 'Assign the result array to the function result. getRecordsetAsArray = results '========================================================================================================== ExitPoint: Set rs = eraseRecordset(rs) Exit Function '---------------------------------------------------------------------------------------------------------- ConnectionException: 'Error handler for the case if the input parameter [connection] is not of ADODB.Connection class or if 'this connection is closed. GoTo ExitPoint SQLException: 'Error handler for the case if the given SQL query cannot be completed for any reason. GoTo ExitPoint End Function