Export to Excel in VB6

'Declarations...
Dim strAppDetails As String 'Used as part of the Report page footer...
Dim adoCon As ADODB.Connection 'DB Connection...
Dim adoRs As ADODB.Recordset 'Recordset upon which the report will be based...
Dim excapp As Excel.Application
Dim excwb As Excel.Workbook
Dim excss As Excel.Worksheet
Dim excs As Excel.Worksheet

'Switch on error handler...
On Error GoTo Errhandler

Set excapp = New Excel.Application 'Create a new instance of Excel
Set excwb = excapp.Workbooks.Add 'Add a new workbook
'excwb.Worksheets(0).Delete 'Delete worksheets
excwb.Worksheets(1).Delete
excwb.Worksheets(2).Delete
Set excss = excwb.ActiveSheet 'Active current worksheet
'Set excss = excwb.Worksheets.Add 'Add a new worksheet

excss.Name = "FileTracker Report" 'Name the Excel Report
excapp.Visible = True 'Show it to the user

'Set Mouse pointer (Reset in the form's "Activate" sub)...
Screen.MousePointer = vbHourglass

'Create DB objects...
Set adoCon = New ADODB.Connection
Set adoRs = New ADODB.Recordset

'Login to database
adoCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Password=" & Chr$(89) & Chr$(101) & Chr$(108) & Chr$(111) & Chr$(119) & Chr$(75) & Chr$(97) & Chr$(110) & Chr$(97) & Chr$(114) & Chr$(121) & ";" & _
"User ID=" & frmMDI.staMain.Panels("UserName").Text & ";" & _
"Data Source=" & gdbFTrak.Name & ";" & _
"Jet OLEDB:System database=" & DBEngine.SystemDB

'Build Recordset...
With adoRs
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.ActiveConnection = adoCon
.Open mstrSql
If .RecordCount > 0 Then
.MoveFirst
End If
End With

' Fill the Excel with the recordset data
Dim iCount As Integer


With excss
For iCount = 0 To (adoRs.Fields.Count - 1)
.Cells(1, iCount + 1) = adoRs.Fields(iCount).Name 'Assigning the column names
Next iCount
.Range("A2").CopyFromRecordset adoRs 'Binding the recordset to Excel
End With

'Formating the Date field to dd-mmm-yyyy format
Dim iCount1 As Integer
Dim iCountRec As Integer
Dim excelDate As Date
With excss
For iCount1 = 0 To (adoRs.Fields.Count - 1)
If adoRs.Fields(iCount1).Name = "DateOfLoss" Or adoRs.Fields(iCount1).Name = "DateToLoc" Then
For iCountRec = 0 To (adoRs.RecordCount - 1)
excss.Application.ActiveCell(iCountRec + 2, iCount1 + 1).NumberFormat = "dd-mmm-yyyy"
Next iCountRec
End If
Next iCount1
End With


Clearup:
'Housekeeping - destroy the recordset and reclaim memory...
Set excwb = Nothing 'Disconnect from Excel (let the user take over)
Set excapp = Nothing
Set adoRs = Nothing

'Set Mouse pointer (Reset in the form's "Activate" sub)...
Screen.MousePointer = vbDefault

'Don't fall into the error handler...
Exit Sub

Errhandler: '---------------------------------------------
'Reset Mouse pointer...
Screen.MousePointer = vbDefault

Select Case Err.Number
Case Else
'Call the unanticipated error handler...
Call Errhandler(Err, "cmdExportToExcel_Click")
End Select

'Exit gracefully...
Resume Clearup