Creating a Header Row in Excel from an ADO Recordset

I recently published an article about how to use ADO's .NextRecordset method to iterate through multiple result sets (i.e., SELECT queries) from a SQL Server stored procedure:

Over at LinkedIn, longtime reader Joakim Dalby asked an obvious followup question:

Did you managed to get the name of columns into Excel too?

As a matter of fact, I did not include that functionality in the original article. Let's rectify that now.

tl;dr: Code Changes

To implement this additional feature, we add the following lines of code:

' Write headers
Dim i As Integer
For i = 0 To rs.Fields.Count - 1
    Worksheets(wsNames(wsIndex)).Cells(1, i + 1).Value = rs.Fields(i).Name
Next i

Additionally, we change the CopyFromRecordset line to use "A2" as the upper left cell instead of "A1":

BEFORE

Worksheets(wsNames(wsIndex)).Range("A1").CopyFromRecordset rs

AFTER

Worksheets(wsNames(wsIndex)).Range("A2").CopyFromRecordset rs

The Full Code

Here's the updated sample code:

Sub PopulateWorksheetsWithRecordsets()
    ' Initialize the connection
    Dim Conn As ADODB.Connection
    Set Conn = New ADODB.Connection
    Conn.ConnectionString = "Provider=SQLOLEDB;Data Source=MyServer; " & _
                            "Initial Catalog=MyDatabase; Integrated Security=SSPI;"
    Conn.Open
    
    ' Initialize the command
    Dim Cmd As ADODB.Command
    Set Cmd = New ADODB.Command
    With Cmd
        .ActiveConnection = Conn
        .CommandText = "GetYearlyCalendarInformation"
        .CommandType = adCmdStoredProc
        Dim YearParam As Integer
        YearParam = 2024 ' Specify the required year
        .Parameters.Append .CreateParameter("@Year", adInteger, adParamInput, , YearParam)
    End With
    
    ' Execute the command
    Dim rs As ADODB.Recordset
    Set rs = Cmd.Execute
    
    ' Worksheet names for each recordset
    Dim wsNames As Variant
    wsNames = Array("Months", "Weeks", "Days")
    
    ' Loop through each recordset and copy to a new worksheet
    Dim wsIndex As Integer
    wsIndex = 0
    Do Until rs Is Nothing
        ' Create a new worksheet for each recordset
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = wsNames(wsIndex)
        
        ' Write headers
        Dim i As Integer
        For i = 0 To rs.Fields.Count - 1
            Worksheets(wsNames(wsIndex)).Cells(1, i + 1).Value = rs.Fields(i).Name
        Next i
        
        ' Copy data from recordset
        Worksheets(wsNames(wsIndex)).Range("A2").CopyFromRecordset rs
        wsIndex = wsIndex + 1
        Set rs = rs.NextRecordset
    Loop
    
    ' Clean up
    Conn.Close
    Set rs = Nothing
    Set Cmd = Nothing
    Set Conn = Nothing
    
    MsgBox "Data has been successfully imported into worksheets!"
End Sub

Teaching You How to Fish

Catch a man a fish and he'll eat for a day.
Teach a man to fish and he'll eat for the rest of his life.

I love that saying so much I almost used it as my college yearbook quote. Instead, I used an alternate version that incorporated three of my greatest passions:

A love of teaching
Clever wordplay
A dark sense of humor

Here is my actual college yearbook quote (seriously, you can look it up in the 2002 edition of the USMA Howitzer):

Build a man a fire and he'll be warm for a day.
Set a man on fire and he'll be warm for the rest of his life.

In that spirit, allow me to share some additional details about the code changes above and how you can incorporate the new tools available to us as developers to boost your productivity.

ChatGPT: The Google Obviator

obviator: one who obviates

obviate: to make an action unnecessary

I spend most of my time writing VBA code for Microsoft Access.

However, I've certainly done my share of Excel VBA programming over the years. While most of that time has actually been automating Excel from Access, the key point is that I'm familiar with the Excel object model.

Familiar with the Excel object model. Not fluent in the Excel object model.

Because I'm familiar with the object model, I know what I can do with it. But I don't always remember exactly how. In the past, I could easily refresh my memory with 5 to 10 minutes of Googling for the exact method and property names I needed to use.

ChatGPT saves me that time now.

In my earlier article, I documented my conversation with GPT-4 where it created the sample code I posted. I use poe.com to interact with ChatGPT and other LLMs, so all my past chat conversations are saved there.

To answer Joakim's question, then, I simply posed the same question to ChatGPT as a new prompt in our existing conversation.

[MIKE]: Update the VBA function to include a header row with each Excel tab that uses the column names from the recordsets embedded in the sproc

[GPT-4]: To update the VBA function so that it includes a header row with the column names from the recordsets returned by the stored procedure in each Excel tab, you will need to add a few lines of code to extract the field names from the ADODB.Recordset and write them to the first row of each worksheet before copying the data from the recordset. Below is the modified version of the original subroutine:

{see PopulateWorksheetsWithRecordsets() above}

Key Changes Explained:

Writing Headers: Before copying the data from the recordset to the worksheet, the code now includes a loop that iterates through all the fields in the recordset. It writes the name of each field to the first row of the current worksheet (Cells(1, i + 1)). The i + 1 ensures that the headers start from the first column.
Data Start from A2: The .CopyFromRecordset call now starts from cell A2 of each worksheet to leave space for the header row.

This modified function will ensure that each Excel tab created by the subroutine will have a header row with the names of the columns from the recordset, followed by the data starting from the second row.