ADO Recordset to Excel

Public Sub Recordset2Excel(rstSource As ADODB.Recordset)
Dim xlsApp As Excel.Application
Dim xlsWBook As Excel.Workbook
Dim xlsWSheet As Excel.Worksheet
Dim i, j As Integer
 
 ' Get or Create Excel Object
 On Error Resume Next
 Set xlsApp = GetObject(, "Excel.Application")
 If Err.Number <> 0 Then
  Set xlsApp = New Excel.Application 
	Err.Clear
 End If
 
 ' Create WorkSheet
 Set xlsWBook = xlsApp.Workbooks.Add
 Set xlsWSheet = xlsWBook.ActiveSheet   
 
 ' Export ColumnHeaders
 For j = 0 To rstSource.Fields.Count
  xlsWSheet.Cells(2, j + 1) = rstSource.Fields(j).Name
 Next j
 
 ' Export Data
 rstSource.MoveFirst
 For i = 1 To rstSource.RecordCount
  For j = 0 To rstSource.Fields.Count
   xlsWSheet.Cells(i + 2, j + 1) = rstSource.Fields(j).Value
  Next j  
  rstSource.MoveNext
 Next i 
 rstSource.MoveFirst
  
 ' Autofit column headers
 For i = 1 To rstSource.Fields.Count
  xlsWSheet.Columns(i).AutoFit
 Next i
 ' Move to first cell to unselect
 xlsWSheet.Range("A1").Select
 
 
 ' Show Excel
 xlsApp.Visible = True
 
 Set xlsApp = Nothing
 Set xlsWBook = Nothing
 Set xlsWSheet = Nothing
End Sub