Create Excel data table from ADO recordset

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?
bassman592Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

NorieAnalyst 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

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
ADO

From novice to tech pro — start learning today.