'Primeiro, faça referência ao Microsoft Excell Object Library;
Em um botão de comando coloque o código abaixo:
Public Sub Exportar()
On Error GoTo final
Dim stCelulas As ExlCell
Screen.MousePointer = 11 ' Muda o ponteiro do mouse
Dim iTotalRegistros As Long
FecharRst
sSql = "SELECT * FROM tblFolhaEspelho"
rst.Open sSql, cnBd, adOpenKeyset, adLockOptimistic
iTotalRegistros = rst.RecordCount
FecharRst
If iTotalRegistros > 65000 Then
Screen.MousePointer = 0
MsgBox "O excel suporta apenas 65.000 linhas", vbInformation, "A tabela contém mais de 65.000 linhas!!"
Exit Sub
End If
Set oExcel = CreateObject("Excel.Application")
oExcel.Workbooks.Add 'inclui o workbook
Set objExlSht = oExcel.ActiveWorkbook.Sheets(1)
'**************referencia da base de dados
Set db = OpenDatabase(App.Path & "ImportaTexto.MDB")
Set Sn = db.OpenRecordset("tblFolhaEspelho", dbOpenSnapshot)
' Inclui os dados a partir da celula A1
stCelulas.row = 1
stCelulas.col = 1
CopiarTabelaExcel Sn, objExlSht, stCelulas
'************** Salva a planilha
Dim sPathExcel As String
Dim sArquivo As String
sPathExcel="C:PastaDestino"
sArquivo="NomeArquivo"
objExlSht.SaveAs PathExcel & "" & sArquivo & ".xls"
'**************************************
oExcel.Visible = True
objExlSht.Application.Quit
Set objExlSht = Nothing ' remove a variavel objeto
Set oExcel = Nothing ' remove a variavel objeto
Set Sn = Nothing ' reomove a variavel objeto
Set db = Nothing ' reomove a variavel objeto
Screen.MousePointer = vbDefault ' Restaura o ponteiro do mouse.
MsgBox "A planilha foi exportada para a pasta:" & Path, vbInformation, "Planilha exportada com sucesso!!"
Exit Sub
final:
MsgBox Err.Number & ": " & Err.Description, vbInformation, "Ocorreu um erro ao gerar a planilha excel!!"
End Sub
