SQL Server 2014 Stored Procedure with Output

The code below is a stored procedure that uses the AdventureWorks2014 database Production schema. There is an OUTPUT variable that will deliver the number of worksheets back to the VBA code in Excel and the first dataset is the list of the worksheets to be populated into an array that will be used while the code iterates through each of the additional recordsets to populate all sheets required for the report.

ALTER PROCEDURE [dbo].[usp_ProductsXLS]
@x int=0 OUTPUT
AS
/* Production Parts report pages in Excel */
Declare @pcID int
Declare @i int, @z int

/* OUTPUT results*/
select @z = count(*) from (
SELECT ProductCategoryID, Name FROM Production.ProductCategory
group by ProductCategoryID, Name) as p

Declare @prods TABLE
(ID int not null,
ProductCategoryID int,
ProductName varchar(50)
);

INSERT INTO @prods
select Row_Number() over (ORDER BY Name DESC) as ID,
ProductCategoryID, Name as ShtName
FROM Production.ProductCategory
group by ProductCategoryID, Name

--the Sheet Name recordset....
Select * From @prods

/* OUTPUT result sheets */
set @x = @z
set @i = 1

While @i <= @z
BEGIN

select @pcID=ProductCategoryID
FROM @prods
WHERE ID = @i

select pc.Name as Category, ps.Name as Subcategory, p.Name as ProductName,
ProductNumber, ListPrice, StandardCost
from Production.Product p inner join Production.ProductSubcategory ps
on ps.ProductSubcategoryID = p.ProductSubcategoryID
inner join Production.ProductCategory pc on pc.ProductCategoryID = ps.ProductCategoryID
where pc.ProductCategoryID = @pcID
ORDER BY p.Name asc

set @i = @i + 1

END

Excel Code Processing

The first part of the VBA code declares the variables: ADODB Recordset, Command, and Connection variables and a couple of Arrays for the Worksheet names and Field Names (as Excel Cells (A1, B1, etc.) as well as numeric variables to iterate through a loop using Char on the ASCII value to populate the field Excel names and count the rows, and one X for the output variable returned from the SQL Server Stored Proc. The code also performs from formatting with Column Width, Bold font and a header row before finally disposing of the ADODB Recordset and connection at the end.

Dim ws As Worksheet
Dim cmd As ADODB.Command
Dim rs As ADODB.Recordset
Dim cn As ADODB.Connection
Dim stCell As Long, iRecCount As Long
Dim i As Long, j As Long
Dim stClass() As String, stFields() As String
Dim rng As Range
Dim iCount As Long
Dim errmsg As String
Dim a As Long, b As Long, c As Long
Dim iArray As Long
Dim x As Long

On Error GoTo errHandler

stCell = 1
iArray = 6

ReDim Preserve stFields(iArray)

a = 1
b = 64
c = 1

Do While a < 7
stFields(a) = Chr(b + a)
a = a + 1
Loop

Set cn = New ADODB.Connection
cn.ConnectionString = GLOBAL_DB_CXN_STRING
cn.Open
Set cmd = New ADODB.Command
Set rs = New ADODB.Recordset

'Call ADODB Command type of Stored Proc with a Parameter for @x, the output
'from SQL Server with the worksheet count
With cmd
.CommandType = adCmdStoredProc
.CommandText = "usp_ProductsXLS"
.CommandTimeout = 300
.ActiveConnection = cn 'Connection object
.Parameters.Refresh
Set rs = .Execute
x = .Parameters("@x")
End With

Do Until (rs.State = adStateOpen)
Set rs = rs.NextRecordset
Loop

'Redimension the Array for the workseeths and iterate from 1 to x for the Wkst names
ReDim Preserve stClass(x)
For i = 1 To (x)
Debug.Print rs.Fields(2).Value
stClass(i) = rs.Fields(2).Value
rs.MoveNext
Next i

'loop through the array getting the recordsets & wkshts
For i = 1 To (x) Set rs = rs.NextRecordset
Set ws = Sheets.Add
ws.Name = stClass(i)
ActiveWindow.Zoom = 80

'Test to see if we have records
If Not (rs.BOF And rs.EOF) Then
'Copy recordset to the range
rs.MoveLast
rs.MoveFirst
Set rng = ThisWorkbook.ActiveSheet.Range("a1")
rng.CopyFromRecordset rs
End If

iRecCount = ActiveSheet.UsedRange.Rows.Count
Range("E" & stCell & ":F" & stCell + iRecCount).NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"

Columns("A:A").ColumnWidth = 17
Columns("B:B").ColumnWidth = 17
Columns("C:C").ColumnWidth = 25
Columns("D:D").ColumnWidth = 22
Columns("E:F").ColumnWidth = 20

'header
Rows("1:1").Select
Selection.Insert Shift:=xlDown

For j = 1 To iArray
Range(stFields(j) & "1").Select
ActiveCell.FormulaR1C1 = rs.Fields(j - 1).Name
Next j

Rows("1:1").Select
Selection.Font.Bold = True

Rows("1:2").Select
Range("A2").Activate
ActiveWindow.FreezePanes = True

Columns("A:A").Select
Next i

Set rs = Nothing
Set cmd = Nothing
cn.Close
Set cn = Nothing

ExitHandler:
Exit Function
errHandler:
errmsg = "Error: " & Err.Number & ":" & Err.Description
MsgBox errmsg

Resume ExitHandler

End Function 

Test the code by naming it as a Function and calling it from the ThisWorksheet code and test it to see the results. (ALT + F11). Worksheets are populated and columns formatted.

All of the worksheets are produced and named from the Stored Proc.