EXPORTAR EXCEL

Public Sub TblCadastroInss()
Dim stCell As ExlCell
Set oExcel = CreateObject("Excel.Application")
oExcel.Workbooks.Add   'inclui o workbook
Set objExlSht = oExcel.ActiveWorkbook.Sheets(1)

Dim Inss As Recordset
Caminho = ReadINI("Caminho", "BD", App.Path & "\CooperNet.ini")
Set CpnInfo = Workspaces(0).OpenDatabase(Caminho)
Set Inss = CpnInfo.OpenRecordset("TblCadastroInss", dbOpenSnapshot)

' Inclui os dados a partir da celula A1
stCell.row = 1
stCell.col = 1
CopiarTabelaExcel Inss, objExlSht, stCell

' Salva a planilha
objExlSht.SaveAs "C:\Backup\TblCadastroInss.xls"

oExcel.Visible = False
objExlSht.Application.Quit

Set objExlSht = Nothing   ' remove a variavel objeto
Set oExcel = Nothing       ' remove a variavel objeto
Set Inss = Nothing             ' reomove a variavel objeto
Set CpnInfo = Nothing             ' reomove a variavel objeto
End Sub

Private Sub CopiarTabelaExcel(rs As Recordset, WS As Worksheet, StartingCell As ExlCell)
Dim Vetor() As Variant
Dim row As Long, col As Long
Dim fd As Field

rs.MoveLast
ReDim Vetor(rs.RecordCount + 1, rs.Fields.Count)

' Copia as colunas do cabecalho para um vetor
col = 0
For Each fd In rs.Fields
  Vetor(0, col) = fd.Name
  col = col + 1
Next

' copia o rs par um vetor
rs.MoveFirst
For row = 1 To rs.RecordCount - 1
   For col = 0 To rs.Fields.Count - 1
       Vetor(row, col) = rs.Fields(col).Value
       'O Excel não suporta valores NULL em uma célula.
       If IsNull(Vetor(row, col)) Then Vetor(row, col) = ""
   Next
   rs.MoveNext
Next
WS.Range(WS.Cells(StartingCell.row, StartingCell.col), WS.Cells(StartingCell.row + rs.RecordCount + 1, _
StartingCell.col + rs.Fields.Count)).Value = Vetor

End Sub