[Resolvido]Layout de Saída Exportando TXT

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


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

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?

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: http://brzaccessdeveloper.blogspot.com/2012/06/vba-access-exportando-dados-para-um.html

Informe o resultado.

Boa sorte, Delson

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

Prezado Eloirp,

Fico satisfeito em poder auxiliar.

Obrigado pelo retorno!

Sucesso, Delson