MaximoAccess

Caro Usuário, não tire as suas duvidas nas Salas de Repositório, abra sempre um novo tópico relacionado, nas salas destinadas para o efeito, como Sala de Tabelas, Consultas, Formulários, Relatórios, Macros, Módulos e VBA.

Obrigado

Administração do MaximoAccess

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

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

    Compartilhe

    Plauto
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 4
    Registrado : 12/08/2015

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

    Mensagem  Plauto em Ter 18 Out 2016, 05:43

    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

    good guy
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 920
    Registrado : 05/02/2010

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

    Mensagem  good guy em Ter 18 Out 2016, 21:03

    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

    Plauto
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 4
    Registrado : 12/08/2015

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

    Mensagem  Plauto em Sab 29 Out 2016, 14:51

    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

      Data/hora atual: Sab 10 Dez 2016, 04:53