exportar do access para excel (ADO) com problema de formato (integer e date)

Amigos,

Estou tentando transferir os dados de uma tabela no access para o Excel, mas os campos que são numéricos e data, quando transferidos para a planilha, ficam no formato "geral" apesar de estarem com o formato correto na tabela. Destaquei as linhas em negrito. Tentei usar o Cdate e Cint, mas mesmo assim não tive sucesso. Agradeço se alguém ajudar. Segue o código:
Obs.: a planilha tem um cabeçalho com os títulos dos campos.

Private Sub Comando576_DblClick(Cancel As Integer)
Dim db As DAO.Database
Dim strTabela As String
Dim strSQL As String
Dim bdExcel As DAO.Database
Dim rs As DAO.Recordset
Dim numreg As Long
Dim nContador As Long
Dim vQTDE_CAIXA As Integer

'Passa o local e nome do arquivo para a variável
strArquivo = Path()

'Abre arquivo
Set bdExcel = OpenDatabase(strArquivo, False, False, "Excel 12.0;HDR=Yes;IMEX=0;")

'Monta a consulta do Recordset
strSQL = "SELECT * FROM [AQUISIÇÕES$]"

'Abre o Recordset da consulta
Set rs = bdExcel.OpenRecordset(strSQL)

Set db = CurrentDb()
Set TBNF = db.OpenRecordset("SELECT TB_NotaFiscal.DT_NF, TB_NotaFiscal.EAN, TB_NotaFiscal.QTDE_CAIXA, TB_NotaFiscal.NU_NF, TB_NotaFiscal.FORNECEDOR, TB_NotaFiscal.[ANÁLISE DA NF], TB_NotaFiscal.[MOTIVO DA DESCONSIDERAÇÃO], TB_NotaFiscal.MEDICAMENTO, TB_NotaFiscal.NF_CHAVE, TB_NotaFiscal.CNPJ_FORNECEDOR, TB_NotaFiscal.ITEM_NF, TB_NotaFiscal.Data_de_validade, TB_NotaFiscal.Fase_NF, TB_NotaFiscal.DT_IMPORTAÇÃO FROM TB_NotaFiscal;")
TBNF.MoveLast
numreg = TBNF.RecordCount
If numreg <> 0 Then
   TBNF.MoveFirst
End If
For nContador = 1 To numreg

   'Adiciona novo produto à lista
   rs.AddNew
   rs!DT_NF = CDate(TBNF!DT_NF)
   rs!EAN = TBNF!EAN
   vQTDE_CAIXA = CInt(TBNF!QTDE_CAIXA)
   rs!QTDE_CAIXA = vQTDE_CAIXA
   rs!NU_NF = TBNF!NU_NF
   rs!FORNECEDOR = TBNF!FORNECEDOR
   rs![ANÁLISE DA NF] = TBNF![ANÁLISE DA NF]
   rs![MOTIVO DA DESCONSIDERAÇÃO] = TBNF![MOTIVO DA DESCONSIDERAÇÃO]
   rs![MEDICAMENTO] = TBNF![MEDICAMENTO]
   rs!NF_CHAVE = TBNF!NF_CHAVE
   rs!CNPJ_FORNECEDOR = TBNF!CNPJ_FORNECEDOR
   rs!ITEM_NF = TBNF!ITEM_NF
   If IsNull(TBNF!Data_de_validade) = False Then
       rs!Data_de_validade = CDate(TBNF!Data_de_validade)
   End If
   rs!Fase_NF = TBNF!Fase_NF
   rs!DT_IMPORTAÇÃO = CDate(TBNF!DT_IMPORTAÇÃO)
   rs.Update
   
   TBNF.MoveNext
Next

'fecha o Recordset
rs.Close
Set rs = Nothing

'Fecha o arquivo Excel
bdExcel.Close
Set bdExcel = Nothing
MsgBox "A planilha foi atualizada...", vbInformation, "Aviso"
End Sub

Olá plauto,

Já tentou este link:

answers.microsoft.com/pt-br/msoffice/forum/msoffice_other-mso_other/transportar-minha-tabela-access-para-excel-via-vba/e7d6f083-8742-4619-8854-01450ce11107

Good Guy,

Acabei usando do artificio de preencher a primeira linha da aba utilizando o objeto workbooks, uma vez preenchida a primeira linha com os tipos corretos o recordset funciona, mantendo o tipo coluna conforme o primeira registro.


Obrigado pela sugestão.

------


O código ficou assim:

Function PreenchePlan(varFile)

'Private Sub Comando576_DblClick(Cancel As Integer)
Dim db As DAO.Database
Dim strTabela As String
Dim strSQL As String
Dim bdExcel As DAO.Database
Dim rs As DAO.Recordset
Dim numreg As Long
Dim nContador As Long
Dim td As TableDef
Set db = CurrentDb

   
   On Error GoTo XLError
   
   'Passa o local e nome do arquivo para a variável - exemplo
   strArquivo = CurrentProject.Path & "\ListaClientes.xls"
   
   'insere a primeira linha com os o tipo correto de dados
   Call Linha1
   
   'Abre arquivo planilha fonte FnsRepasse.xls
   Set bdExcel = OpenDatabase(strArquivo, False, False, "Excel 12.0;HDR=Yes;IMEX=0;")
   
   
   'Monta a consulta do Recordset
   strSQL = "SELECT * FROM [Nome da aba$]"
   
   'Abre o Recordset da consulta
   Set rs = bdExcel.OpenRecordset(strSQL)
   
           
            ' Create a new TableDef using the passed name.
            strNewAccTable = "TB_Transf_temp"
            Set td = db.CreateTableDef(strNewAccTable)
           
            td.Connect = "Excel 8.0;DATABASE=" & varFile & ";"
            td.SourceTableName = "nome da planilha origem dos dados" & "$"
            db.TableDefs.Append td
           
   
   Set db = CurrentDb()
   
   
   Set TBNF = db.OpenRecordset("SELECT * FROM TB_Transf_temp;")
   TBNF.MoveLast
   numreg = TBNF.RecordCount
   If numreg <> 0 Then
       TBNF.MoveFirst
   End If
   
   
   For nContador = 1 To numreg
       'Adiciona novo produto à lista
       If nContador = 1 Then
           rs.Edit ' sobrepoem os dados da primeira linha utilizados para formatação
           Else
           rs.AddNew
       End If
       rs!Competência = TBNF!Competência
       rs![Nº OB] = TBNF![Nº OB]
       rs![Data OB] = TBNF![Data OB]
       rs![Banco OB] = TBNF![Banco OB]
       rs![Agência OB] = TBNF![Agência OB]
       rs![Conta OB] = TBNF![Conta OB]
       rs![Valor Líquido] = TBNF![Valor Líquido]
       rs!Desconto = TBNF!Desconto
       rs![Valor Total] = TBNF![Valor Total]
       rs!Observação = TBNF!Observação
       rs!Processo = TBNF!Processo
       rs![Tipo Repasse] = TBNF![Tipo Repasse]
       rs!Parcela = TBNF!Parcela
       rs![Nº Proposta] = TBNF![Nº Proposta]
       rs![Tipo_de_Serviço] = TBNF![Tipo de Serviço]
       rs!CNPJ = TBNF!CNPJ
       rs.Update
           
       TBNF.MoveNext
   Next
   
   'fecha o Recordset
   rs.Close
   Set rs = Nothing
   'desvincula tabela temporária
   DoCmd.DeleteObject acTable, "TB_Transf_temp"
   'Fecha o arquivo Excel
   bdExcel.Close
   Set bdExcel = Nothing
   MsgBox "A planilha foi atualizada... com os pagamentos.", vbInformation, "Aviso"
   'Exit Function
   XLError:
            MsgBox (Err.Número & " " & Err.Number)
       
End Function

---

Obs.: Função que adiciona, na primeira linha após o título, informações com o tipo de dados correto. Esses dados são substituidos após retornar a funcão prinicipal.


Function Linha1()
Dim oWkb As Excel.Workbook
Dim oWks As Excel.Worksheet
Dim vVar As String
vVar = Path()

'AbreExcel()
Dim Exc As Object   'Excel.Application
Dim xl As Object    'Excel.Workbook
Set Exc = CreateObject("Excel.application")
Set xl = Exc.Workbooks.Open(vVar)
Exc.Visible = False

'Garva primeira linha com as colunas que necessitam de formato
Set oWkb = GetObject(vVar)
Set oWks = oWkb.Worksheets("FnsRepasse")

oWks.Range("A2").Value = "String"
oWks.Range("C2").Value = #10/18/2016 12:00:01 AM#
oWks.Range("G2").Value = 0.1
oWks.Range("H2").Value = 0.1
oWks.Range("I2").Value = 0.1


' Salvar e fechar arquivo
oWkb.Save
oWkb.Close     ' encerra destino

'Set oWkb = Nothing     ' encerra destino
'Set oWks = Nothing    ' encerra destino

'ThisWorkbook.Close SaveChanges:=True    ' salva e fecha planilha origem.
'ThisWorkbook.Application.Quit

End Function