Exportar consulta SQL a Excel

[ManuNic]

Dim Int_Columnas As Integer
Dim Int_Filas As Integer
Dim rs_main As New ADODB.Recordset
Dim excelApp As Excel.Application
Dim excellibro As Excel.Workbook
Dim excelhoja As Excel.Worksheet
Dim Titulo(8) As String
Conectar
Set rst = GETRECORD(SQL, Servidor, optimista)
If Not rst.RecordCount > 0 Then
MsgBox "No hay Registros que Exportar...", vbCritical, Me.Caption
Exit Sub
End If
PBar1.Min = 1
PBar1.Max = rst.RecordCount + 2
Me.MousePointer = 11
Me.Flex2.MousePointer = 11
PBar1.Visible = True
PBar1.Value = 1 'Titulos de Columnas
Titulo(1) = "Producto"
Titulo(2) = "Monto"
Titulo(3) = "Fecha"
Titulo(4) = "Dependencia"
Titulo(5) = "# Cheque"
Titulo(6) = "Proveedor"
Titulo(7) = "Rubro"
Titulo(8) = "Observaciones"
'Definiendo la nueva aplicacion en Excel
Set excelApp = New Excel.Application
Set excellibro = excelApp.Workbooks.Add
Set excelhoja = excellibro.ActiveSheet
Int_Columnas = 8
For I = 1 To Int_Columnas
excelhoja.Cells(1, I) = Titulo(I)
Next
'Llenando la hoja de execel desde el recorset que se definio (Filtro)
If rst.RecordCount > 0 Then
rst.MoveFirst
For Int_Filas = 1 To rst.RecordCount
contador = contador + 1
PBar1.Value = contador
excelhoja.Cells(Int_Filas + 2, 0 + 1) = rst.Fields(0)
excelhoja.Cells(Int_Filas + 2, 1 + 1) = Format(rst.Fields(1), "###,###,##0.00")
excelhoja.Cells(Int_Filas + 2, 2 + 1) = Format(rst.Fields(2), "dd/mm/yyyy hh:mm:ss")
excelhoja.Cells(Int_Filas + 2, 3 + 1) = rst.Fields(3)
excelhoja.Cells(Int_Filas + 2, 4 + 1) = rst.Fields(4)
excelhoja.Cells(Int_Filas + 2, 5 + 1) = rst.Fields(5)
excelhoja.Cells(Int_Filas + 2, 6 + 1) = rst.Fields(6)
excelhoja.Cells(Int_Filas + 2, 7 + 1) = rst.Fields(7)
rst.MoveNext
Next Int_Filas
End If
PBar1.Visible = False 'Barra de progreso
Me.MousePointer = flexDefault
Me.Flex2.MousePointer = flexDefault

excelApp.Visible = True 'Mostrar la Aplicacion de Excel
ConexionSql.Close