MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

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

    [Resolvido]Layout de Saída Exportando TXT

    Compartilhe
    avatar
    Eloirp
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 182
    Registrado : 15/06/2013

    [Resolvido]Layout de Saída Exportando TXT

    Mensagem  Eloirp em 27/7/2018, 21:09

    Olá Pessoal,

    Já pesquisei um monte e não consegui encontrar no fórum uma solução...

    Estou exportando uma tabela com uma única coluna para um arquivo TXT, porém ele cria o arquivo com o nome da coluna e linhas divisórias, tem como limpar isso na criação do arquivo?

    Saída Atual:
    ------------------------------------------------------------------------------------
    |                                    Aplicacao                                     |
    ------------------------------------------------------------------------------------
    | FORD BELINA 1.6L 8V CHT   Câmbio    1978.01  ~ 1986.12                           |
    ------------------------------------------------------------------------------------
    | FORD CORCEL 1.6L 8V CHT   Câmbio    1978.01  ~ 1986.12                           |
    ------------------------------------------------------------------------------------
    | FORD DEL REY 1.6L 8V CHT   Câmbio    1981.01  ~                                  |
    ------------------------------------------------------------------------------------
    | FORD PAMPA 1.6L 8V CHT   Câmbio    1981.01  ~                                    |
    ------------------------------------------------------------------------------------
    | FORD SCALA 1.6L 8V                    Câmbio    1983.01  ~                       |
    ------------------------------------------------------------------------------------



    Saída desejada:
    FORD BELINA 1.6L 8V CHT   Câmbio    1978.01  ~ 1986.12                        
    FORD CORCEL 1.6L 8V CHT   Câmbio    1978.01  ~ 1986.12          
    FORD DEL REY 1.6L 8V CHT   Câmbio    1981.01  ~                    
    FORD PAMPA 1.6L 8V CHT   Câmbio    1981.01  ~                                  
    FORD SCALA 1.6L 8V          Câmbio    1983.01  ~  



    Código Utilizado:
    Código:
    Private Sub Comando46_DblClick(Cancel As Integer)

    Dim ProdutoAplic
    Dim Produto
    Dim strRelPathAplica

    strRelPathAplica = "C:\SieWeb\Relatorios\Aplicacoes"

    CurrentDb.Execute "DELETE * FROM tbl_Aplicacao"

    Call Cnn_Open
    strRS = "SELECT * FROM a_itens_ativos"
    Set rs = cnn.Execute(strRS)

        Do While Not rs.EOF
        
            Produto = rs!Produto
            
            strRS2 = "SELECT tbl_Aplicacao.Codigo, tbl_Aplicacao.AplApl, tbl_Montadora.Montadora, tbl_Aplicacao.Cambio, tbl_ModeloRed.ModeloReduz,tbl_Modelo.Modelo,tbl_Aplicacao.AplDetalhe, tbl_Aplicacao.AplAnoIni, tbl_Aplicacao.AplAnoFim, tbl_Aplicacao.Etiqueta, tbl_Aplicacao.Original, tbl_Aplicacao.Catalogo " & _
                    "FROM tbl_ModeloRed INNER JOIN (tbl_Modelo INNER JOIN (tbl_Montadora INNER JOIN tbl_Aplicacao ON tbl_Montadora.Codigo = tbl_Aplicacao.AplMont) ON tbl_Modelo.Codigo = tbl_Aplicacao.AplMod) ON tbl_ModeloRed.Codigo = tbl_Modelo.ModeloReduz " & _
                    "WHERE (((tbl_Aplicacao.AplApl)='" & Produto & "') AND ((tbl_Aplicacao.Status)='ATIVO')) " & _
                    "ORDER BY tbl_Montadora.Montadora, tbl_ModeloRed.ModeloReduz,tbl_Modelo.Modelo,tbl_Aplicacao.AplDetalhe, tbl_Aplicacao.AplAnoIni"
            Set Rs2 = cnn.Execute(strRS2)
            
            Do While Not Rs2.EOF
            
                ProdutoAplic = Rs2!Montadora & " " & Rs2!ModeloReduz & " " & Rs2!Modelo & " " & Rs2!AplDetalhe & "   Câmbio " & Rs2!Cambio & "   " & Rs2!AplAnoIni & " ~ " & Rs2!AplAnoFim
                CurrentDb.Execute "INSERT INTO tbl_Aplicacao (Aplicacao) VALUES ('" & ProdutoAplic & "')"
                
                
                Rs2.MoveNext
            Loop
            Set Rs2 = Nothing: Close
                    
            strCaminhoCompleto = "" & strRelPathAplica & "\" & Produto & ".txt"
            DoCmd.OutputTo acOutputTable, "tbl_Aplicacao", "MS-DOSText(*.txt)", strCaminhoCompleto, True, "", , acExportQualityPrint
            '"", True, "", , acExportQualityPrint
            
            Application.FollowHyperlink strCaminhoCompleto
            
            CurrentDb.Execute "DELETE * FROM tbl_Aplicacao"
                    
            Contagem = Contagem + 1
            Me.Conta = Contagem
                
        rs.MoveNext
        Loop
        Set rs = Nothing: Close
        Set cnn = Nothing: Close

    End Sub

    delsonk
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 100
    Registrado : 26/11/2013

    Re: [Resolvido]Layout de Saída Exportando TXT

    Mensagem  delsonk em 28/7/2018, 01:38

    Boa noite,

    verifique se o formato .txt abaixo, que gerei com o assistente do Access.

    100 1 Camiseta M Peç
    101 2 Camiseta G Peç
    102 3 Calça M Peç
    103 4 Bermuda M Peç
    104 5 Bermuda G
    105 6 Bermuda GG
    106 7 Camiseta GG
    107 8 Pólo M
    108 9 Pólo G
    109 10 Pólo GG
    110 11 Calça G
    111 12 Boné
    112 13 Máscaras PFF2
    113 14 Botina 43 CA - 17015

    Serve?

    Abraço, Delson
    avatar
    Eloirp
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 182
    Registrado : 15/06/2013

    Re: [Resolvido]Layout de Saída Exportando TXT

    Mensagem  Eloirp em 28/7/2018, 11:09

    Olá Delsonk,
    Visualmente parece que serve, mas precisa ser via código para o usuário executar, pois o usuário não tem acesso ao assistente do Access! Você tem o código?

    delsonk
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 100
    Registrado : 26/11/2013

    Re: [Resolvido]Layout de Saída Exportando TXT

    Mensagem  delsonk em 28/7/2018, 13:48

    Bom dia.

    Consegui o código para você.

    Neste caso, exportei os dados contidos da tabela Cad_Produtos do BD atual.

    'No botão para chamar o código:

    Call ExportData(CurrentProject.Path & "\" & "Testetxt" & ".txt")

    'A Funcão:

    Function ExportData(strExportFile As String)
       Dim rs As Recordset
       Dim strData As String
       Dim intFileNum As Integer
       Dim nDelim As String

       Let intFileNum = FreeFile()
       Let nDelimi = " "

       Open strExportFile For Output As #intFileNum

       Set rs = CurrentDb.OpenRecordset("Cad_Produtos", dbOpenSnapshot)

       With rs
           Do Until .EOF
               Let strData = ![IdConta] & nDelimi & ![Cód_Prod] & nDelimi & ![Descrição] & nDelimi & ![UM]
               Print #intFileNum, strData
               .MoveNext
           Loop
       End With

       Close #intFileNum
       rs.Close
       Set rs = Nothing
    End Function

    O resultado será exatamente o constante do arquivo em anexo.

    Fonte: [Você precisa estar registrado e conectado para ver este link.]

    Informe o resultado.

    Boa sorte, Delson
    Anexos
    Testetxt.txt
    Você não tem permissão para fazer download dos arquivos anexados.
    (1 Kb) Baixado 7 vez(es)
    avatar
    Eloirp
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 182
    Registrado : 15/06/2013

    Re: [Resolvido]Layout de Saída Exportando TXT

    Mensagem  Eloirp em 28/7/2018, 18:49

    Muito Obrigado DelsonK, ficou show!

    Ficou assim o código principal:
    Dim ProdutoAplic
    Dim Produto
    Dim strData As String
    Dim intFileNum As Integer
    Dim strExportFile As String

    Let intFileNum = FreeFile()

    Call Cnn_Open
    If Me.BuscarProd = "*" Then
       strRS = "SELECT Produto FROM tbl_Produto WHERE Comercial='SIM' AND Comercial2='SIM' AND (TipoProduto=1 or TipoProduto=8 or TipoProduto=16) AND Status='ATIVO' "
    Else
       strRS = "SELECT Produto FROM tbl_Produto WHERE Produto='" & Me.BuscarProd & "' AND Comercial='SIM' AND Comercial2='SIM' AND (TipoProduto=1 or TipoProduto=8 or TipoProduto=16) AND Status='ATIVO' "
    End If
    Set rs = cnn.Execute(strRS)

       Do While Not rs.EOF

          Produto = rs!Produto
          strExportFile = Me.Destino & "\" & Produto & ".txt"

           strRS2 = "SELECT tbl_Aplicacao.Codigo, tbl_Aplicacao.AplApl, tbl_Montadora.Montadora, tbl_Aplicacao.Cambio, tbl_ModeloRed.ModeloReduz,tbl_Modelo.Modelo,tbl_Aplicacao.AplDetalhe, tbl_Aplicacao.AplAnoIni, tbl_Aplicacao.AplAnoFim, tbl_Aplicacao.Etiqueta, tbl_Aplicacao.Original, tbl_Aplicacao.Catalogo " & _
                    "FROM tbl_ModeloRed INNER JOIN (tbl_Modelo INNER JOIN (tbl_Montadora INNER JOIN tbl_Aplicacao ON tbl_Montadora.Codigo = tbl_Aplicacao.AplMont) ON tbl_Modelo.Codigo = tbl_Aplicacao.AplMod) ON tbl_ModeloRed.Codigo = tbl_Modelo.ModeloReduz " & _
                    "WHERE (((tbl_Aplicacao.AplApl)='" & Produto & "') AND ((tbl_Aplicacao.Status)='ATIVO')) " & _
                    "ORDER BY tbl_Montadora.Montadora, tbl_ModeloRed.ModeloReduz,tbl_Modelo.Modelo,tbl_Aplicacao.AplDetalhe, tbl_Aplicacao.AplAnoIni"
           Set Rs2 = cnn.Execute(strRS2)
             
               Open strExportFile For Output As #intFileNum
               Print #intFileNum, "KIT DE EMBREAGEM"
               Print #intFileNum, "                "
               Print #intFileNum, "CÓDIGO: " & Produto
               Print #intFileNum, "MARCA: ELPER Automotive Systems"
               Print #intFileNum, "       Powered by SECO Seojin Automotive"
               Print #intFileNum, "       Produzido na Coréia por fabricante original das maiores montadoras mundiais!"
               Print #intFileNum, "                "
               Print #intFileNum, "APLICAÇÃO DO PRODUTO:"
                   
               With Rs2
                  Do Until .EOF
                       ProdutoAplic = Rs2!Montadora & " " & Rs2!ModeloReduz & " " & Rs2!Modelo & " " & Rs2!AplDetalhe & " " & Rs2!AplAnoIni & " ~ " & Rs2!AplAnoFim
                       Let strData = ProdutoAplic
                       Print #intFileNum, strData
                       .MoveNext
                  Loop
               End With
           Rs2.Close
           Set Rs2 = Nothing
               
               Print #intFileNum, "               "
               
               strRS3 = "SELECT Peso,EmbDiam,EmbEstrias,Conteudo FROM tbl_Produto WHERE Produto='" & Produto & "' AND Status='ATIVO' "
               Set Rs3 = cnn.Execute(strRS3)
               If Not Rs3.BOF Then
                   Print #intFileNum, "DETALHES DO PRODUTO:"
                   Print #intFileNum, "Diâmetro: " & Rs3!EmbDiam & "mm e " & Rs3!EmbEstrias & " estrias"
                   Print #intFileNum, "Peso: " & Rs3!Peso & "KG"
                   Print #intFileNum, "Conteúdo: " & Rs3!Conteudo
                   Print #intFileNum, "               "
               End If
               Rs3.Close
               Set Rs3 = Nothing
               
               Print #intFileNum, "GARANTIA:       "
               Print #intFileNum, "10.000KM ou 06 Meses"
               Print #intFileNum, "               "
               Print #intFileNum, "FRETE:"
               Print #intFileNum, "Para consultar as opções de frete clique em Modificar logo abaixo da informação de frete, insira seu CEP e serão listadas as opções, valores e prazos de entrega"
               Print #intFileNum, "               "
               Print #intFileNum, "Não compre na dúvida, utilize as perguntas para esclarecer todas as suas dúvidas antes de efetuar a compra"
               
           Close #intFileNum

           rs.MoveNext
       Loop
       Set rs = Nothing: Close
       Set cnn = Nothing: Close


    e o resultado ficou assim:
    KIT DE EMBREAGEM
                   
    CÓDIGO: 70 332
    MARCA: ELPER Automotive Systems
          Powered by SECO Seojin Automotive
          Produzido na Coréia por fabricante original das maiores montadoras mundiais!
                   
    APLICAÇÃO DO PRODUTO:
    NISSAN MARCH 1.6L 16V  2011  ~
    NISSAN VERSA 1.6L 16V  2011  ~
                 
    DETALHES DO PRODUTO:
    Diâmetro: 200mm e 26 estrias
    Peso: 5,28KG
    Conteúdo: PLATÔ E DISCO
                 
    GARANTIA:      
    10.000KM ou 06 Meses
                 
    FRETE:
    Para consultar as opções de frete clique em Modificar logo abaixo da informação de frete, insira seu CEP e serão listadas as opções, valores e prazos de entrega
                 
    Não compre na dúvida, utilize as perguntas para esclarecer todas as suas dúvidas antes de efetuar a compra
    Anexos
    70 332.txt
    Você não tem permissão para fazer download dos arquivos anexados.
    (1 Kb) Baixado 3 vez(es)

    delsonk
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 100
    Registrado : 26/11/2013

    Re: [Resolvido]Layout de Saída Exportando TXT

    Mensagem  delsonk em 28/7/2018, 23:20

    Prezado Eloirp,

    Fico satisfeito em poder auxiliar.

    Obrigado pelo retorno!

    Sucesso, Delson

      Data/hora atual: 21/10/2018, 23:13