'Function to retrieve query result into two dimensional array

'Function to retrieve query result into two dimensional array
Public Function Func_GetQueryResult(StringQ)

Dim con,rs
Dim resArr()

'Create a connection & recordset object
Set con=CreateObject("ADODB.Connection")
Set rs=CreateObject("ADODB.recordset")


con.connectionString="DRIVER=" & DBDriver & ";Database=" & DBDatabase&" ;Hostname=" & DBHostname & ";Port=" & DBPort & "; Protocol=TCPIP;Uid=" & DBUID & ";Pwd=" & DBPwd


con.Provider = DBProvider
con.Open                    
rs.open StringQ,con

' get the no of records
Dim loopCounter:loopCounter=0
While not rs.EOF
loopCounter=loopCounter+1
rs.MoveNext
Wend

'exit if the query has not returned any result
If loopCounter =0 Then
Reporter.ReportEvent micWarning,"Empty Result Set","Query is: " & StringQ
Func_GetQueryResult=False
Exit Function
End If

'move the recordset object to first row again
rs.MoveFirst

'define the dimensions of the array
ReDim resArr(loopCounter,rs.fields.count-1)

'Loop and store the query result into the array
'first row of the array will contain the field names
'from second row we will have the field values
Dim counter          
Do until rs.EOF              
counter=counter+1
Dim var
For var=0 to rs.fields.count-1
If counter=1 Then                                                                                
resArr(counter-1,var) =rs.fields(var).name
resArr(counter,var) ="'"&rs.fields(var).value                                                                                                                                
else
resArr(counter,var) ="'"&rs.fields(var).value                                                                                                                                                                              
end If
Next
rs.MoveNext
Loop

'close the connection and recordset objects
rs.Close
con.Close        

' return the result
Func_GetQueryResult=resArr
End Function