Binaryworld - How to export ADO recordset to an Excel file ... [ VB -> Excel ]

Some times we have situation when we want to export ADO recordset to an excel file. Here is the code ...

Private Function ExportToExcelFile(strFileName As String, rsData As ADODB.Recordset) As Boolean
  On Error GoTo ExportToExcelFile_Failed
  Dim bolTemp As Boolean

  '//Use for early Binding --You need to add reference to Excel Library
  'Dim objXlsApp As Excel.Application
  'Dim objWB As Excel.Workbook
  'Dim objWS As Excel.Worksheet

  '//Use for Late Binding --//Intelisense wont be available at design time
  Dim objXlsApp, objWB, objWS


  Dim i As Long
  bolTemp = False
  Set objXlsApp = CreateObject("Excel.Application")  'open excel
  Set objWB = objXlsApp.Workbooks.Add  'open a workbook
  Set objWS = objWB.Worksheets(1)  'it should be worksheet1

  'Insert the header row
  For i = 0 To rsData.Fields.Count - 1
    objWS.Cells(1, i + 1).Value = rsData.Fields(i).Name
  Next i
  Debug.Print rsData.RecordCount
  Do While (Not rsData.EOF)

    For i = 0 To rsData.Fields.Count - 1
      objWS.Cells(rsData.AbsolutePosition + 1, i + 1).Value = rsData.Fields(i).Value
    Next i
    rsData.MoveNext

  Loop

  objWS.Columns("A:Z").EntireColumn.AutoFit

  objWB.SaveAs strFileName
  objWB.Close
  objXlsApp.Quit
  bolTemp = True

xit_proc:
  On Error GoTo xit_this
  If Not objWS Is Nothing Then Set objWS = Nothing
  If Not objWB Is Nothing Then Set objWB = Nothing
  If Not objXlsApp Is Nothing Then Set objXlsApp = Nothing

xit_this:
  ExportToExcelFile = bolTemp
  Exit Function
ExportToExcelFile_Failed:
  MsgBox "Error Source:Export to Excel File" & vbCrLf & "Error Description:" & Err.Description
  Resume xit_proc
End Function