Creating a Header Row in Excel from an ADO Recordset
In this followup to my ADO .NextRecordset article, we explore how to create Excel column headers from recordset field names.
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)
). Thei + 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.