Create Excel data table from ADO recordset

bassman592
bassman592 used Ask the Experts™
on
I'm using the following code to write the results of an Oracle query to an Excel worksheet:

Sub GetOracleData()
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim OracleData As Variant
   
    Worksheets("RS").Activate
    ActiveSheet.ListObjects("AgeGroup").DataBodyRange.Value = ""
   
    Set cn = New ADODB.Connection
    Set rs = New ADODB.Recordset
   
    cn.Open ("User ID=USER; Password=PASSWORD; Data Source=DS; Provider=OraOLEDB.Oracle")
   
    rs.CursorType = adOpenForwardOnly
    rs.Open ("select * from age_group"), cn
    OracleData = Application.Transpose(rs.GetRows)
   
   
    ActiveSheet.ListObjects("AgeGroup").DataBodyRange.Resize(UBound(OracleData, 1) - LBound(OracleData, 1) + 1, UBound(OracleData, 2) - LBound(OracleData, 2) + 1) = OracleData
   
   
    'cleanup
    Set rs = Nothing
    Set cn = Nothing
   
End Sub

It works great. However, I had to create the Excel data table "AgeGroup" manually - put in the correct headers and create the data table with the appropriate number of rows. What I would like to do, is create the data table - with column headers - in the procedure, from the recordset, so that if I change the query it will automatically create the appropriate data table. This particular query results in 6 columns and a max of 20 records. If I changed the query to go to a different table - or a join - that results in, say, 100 columns and 4,000 records, I want the data table created to handle that. Can that be done?
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Analyst Assistant
Commented:
Try this.
Sub GetOracleData()
Dim wsRS As Worksheet 
Dim rng As Range
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim I As Long 
    
    Set wsRS = Worksheets("RS")
    Set rng = wsRS.Range("A1")

    Set cn = New ADODB.Connection
    Set rs = New ADODB.Recordset
    
    cn.Open ("User ID=USER; Password=PASSWORD; Data Source=DS; Provider=OraOLEDB.Oracle")
    
    rs.CursorType = adOpenForwardOnly
    rs.Open ("select * from age_group"), cn
    
    For I = 0 To rs.Fields.Count-1
        rng.Offset(,I).Value = rs.Fields(I).Name
    Next I

    rng.Offset(1).CopyFromRecordset rs

    wsRS.ListObjects.Add(xlSrcRange, rng.CurrentRegion, , xlYes).Name = "AgeGroup"

    'cleanup
    Set rs = Nothing
    Set cn = Nothing
    
End Sub

Open in new window

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial