LISTING 5. An Excel Project Procedure to Copy a Return Set

Sub populateWorksheetFromRemoteServer()
Dim cnn1 As ADODB.Connection
Dim rst1 As ADODB.Recordset
Dim int1 As Integer

'Open connection to NorthwindCS database
'on cab2200 server
    Set cnn1 = New ADODB.Connection
    strCnn = "Provider=sqloledb;" & _
    "Data Source=cab2200;" & _
    "Initial Catalog=NorthwindCS;" & _
    "User Id=SQLMagUser;Password=sqlmag;"
    cnn1.Open strCnn
    
'Open employee table
    Set rst1 = New ADODB.Recordset
    rst1.CursorType = adOpenForwardOnly
    rst1.LockType = adLockReadOnly
    rst1.Open "[Ten Most Expensive Products]", _
    cnn1, , , adCmdStoredProc

'Select and rename Sheet1
    Sheets(1).Activate
    Sheets(1).Name = "Top Ten Products"


'Write in column headings in first row
    RowCnt = 1
    For FieldCnt = 0 To rst1.Fields.Count - 1
    Cells(RowCnt, FieldCnt + 1).Value = _
    rst1.Fields(FieldCnt).Name
    Rows(1).Font.Bold = True
    Next FieldCnt

'Fill rows with records, starting at row 2
    RowCnt = 2
    Do Until rst1.EOF
    For FieldCnt = 0 To rst1.Fields.Count - 1
    Cells(RowCnt, FieldCnt + 1).Value = _
    rst1.Fields(FieldCnt).Value
    Next FieldCnt
    rst1.MoveNext
    RowCnt = RowCnt + 1
    Loop
    
'Set Column widths to data and
'right align second column
    Columns("A:A").EntireColumn.AutoFit
    With Columns("B:B")
    .EntireColumn.AutoFit
    .HorizontalAlignment = xlRight
    End With
    
'Close the connection and recover the resource
    cnn1.Close
    Set cnn1 = Nothing

End Sub