Este fórum está sendo desativado

[FranciscoSouza]

Bom dia !

Precisaria remover as Aspas duplas de um arquivo txt, que aparecem em todas as linhas que contenham uma vírgula.
"|0111|8036085,94|204333,06|2094981,56|0,00|10335400,56|"
O correto seria: |0111|8036085,94|204333,06|2094981,56|0,00|10335400,56|
Tentei usar o código abaixo mais não deu certo. Alguém poderia me ajudar?

Public Sub LeArquivoTexto()
Dim Arquivo As Integer
Dim CaminhoArquivo As String, TextoArquivo As String, TextoProximaLinha As String
Dim ContadorLinha As Long

'Configura a leitura do arquivo
Arquivo = FreeFile
CaminhoArquivo = "C:\EFD - 27 12 2016 151051.TXT"
'Abre o arquivo para leitura
Open CaminhoArquivo For Input As Arquivo
ContadorLinha = 1
'Lê o conteúdo do arquivo linha a linha
Do While Not EOF(Arquivo)
Line Input #Arquivo, TextoProximaLinha

If TextoProximaLinha Like "*""*" Then
TextoProximaLinha = Replace(TextoProximaLinha, "*""*", "", 1, , vbTextCompare)
Debug.Print TextoProximaLinha
End If

TextoProximaLinha = TextoProximaLinha & vbCrLf
TextoArquivo = TextoArquivo & TextoProximaLinha
Debug.Print TextoArquivo
Loop

'Coloca na janela de verificação imediata
Debug.Print TextoArquivo

'Fecha o arquivo
Close Arquivo

End Sub

Obrigado.

[DJunqueira]

Vc parece estar complicando uma questão simples, o Excel tem rotina p/ importação de arquivo texto, pq não a utiliza?
Poderia inclusive fazer uma importação temporária p/ depois excluir a planilha.

[gabrielLLLLLLL]

A RESPOSTA PARA RETIRAR ASPAS ESTA AQUI
https://www.youtube.com/watch?v=EsJy0orwDOU&t=5s

[Edcronos]

bem vai ter que ler o arquivo e passar para outro, claro que se pode substituir o arquivo original mas o certo é conservar
agora as questões
por que somente onde houver virgula?
tem lugares que as aspas tem que ser conservadas?
se não tiver é só excluir todas as aspas
esse trecho entre aspas estão no meio de outros textos ou são unicos por linha?
o certo mesmo seria mais conteúdo desse texto
para tirar as aspas teria que ser assim

Código: Selecionar todos

Replace(TextoProximaLinha, """", "", 1, , vbTextCompare)

mas aí iria tirar todas as aspas desse texto e não somente das que tem virgula entre elas

como falei, para tomar uma decisão teria que ver esses texto para saber se teria trecho onde o replace nao poderia ser aplicado
se o replace não puder ser aplicado teria que fazer verificação dupla e ler caractere por caractere
ou usar o "| e o |" para localizar os pontos chaves, tbm se pode usar splite para separar pelas " e juntar depois com join
tem varias maneiras que depende do de cada caso

[Jimmy]

Olá,

Se você explicar melhor sua necessidade podem haver saídas mais simples.
Por enquanto, segue o solicitado.

Para não dificultar o entendimento, alterei o mínimo possível a macro que você postou.
Ela agora lê o arquivo, e grava um novo (na mesma pasta), excluindo as “ das linhas que contém vírgula, e deixando as linhas que não contém vírgula sem alteração.

No final há um IF 1=1, que é onde você deve decidir se renomeia o arquivo original (coloca um OLD na frente do nome) (parte THEN do IF), ou se exclui o original (parte ELSE do IF).

De uma forma ou de outra, o novo arquivo gerado será renomeado com o nome do original.

Jimmy San Juan

Código: Selecionar todos

Public Sub LeArquivoTexto()
    Dim Arquivo As Integer
    Dim CaminhoArquivo As String, TextoArquivo As String, TextoProximaLinha As String
    Dim ContadorLinha As Long
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    'Configura a leitura do arquivo
    PastaArquivos = "C:\"
    CaminhoArquivoR = "EFD - 27 12 2016 151051.TXT"                          'Arquivo Read
    CaminhoArquivoW = "Temp-" & Format(Now, "yyyy.mm.dd.hh.mm.ss") & ".TXT"  'Arquivo Write
    'Abre 1 arquivo para leitura e outro para gravação
    ArquivoR = FreeFile
    Open PastaArquivos & CaminhoArquivoR For Input As ArquivoR
    ArquivoW = FreeFile
    Open PastaArquivos & CaminhoArquivoW For Output As ArquivoW
    
    'Lê o conteúdo do arquivo linha a linha, e grava
    Do While Not EOF(ArquivoR)
        Line Input #ArquivoR, TextoProximaLinha
        If InStr(1, TextoProximaLinha, ",") Then _
            TextoProximaLinha = Replace(TextoProximaLinha, """", "", 1)
        Print #ArquivoW, TextoProximaLinha
    Loop
    Close
    
    If 1 = 1 Then
        CaminhoArquivoO = "OLD " & CaminhoArquivoR     'Arquivo OLD
        If FSO.FileExists(PastaArquivos & CaminhoArquivoO) Then FSO.DeleteFile PastaArquivos & CaminhoArquivoO
        FSO.GetFile(PastaArquivos & CaminhoArquivoR).Name = CaminhoArquivoO
    Else
        If FSO.FileExists(PastaArquivos & CaminhoArquivoR) Then FSO.DeleteFile PastaArquivos & CaminhoArquivoR
    End If
    
    FSO.GetFile(PastaArquivos & CaminhoArquivoW).Name = FSO.GetFileName(CaminhoArquivoR)  'Renomeia arquivo
    
    Set FSO = Nothing
End Sub

[adrdown]

Apesar do tempo, segue solução simples, atenção: a guia que deseja gerar o TXT precisa estar com o nome Extract, se entende o mínimo de VBA altere o nome código abaixo para o nome de sua guia, não me perguntem como funciona o código pois não sei, estou estudado ainda, peguei a solução de outro site em Inglês e adaptei para o que preciso, depois reduzi e fiz esta resumida abaixo que deve resolver para maioria das pessoas...

Códig VBA com a solução:





Sub Exportar_TXT()



Application.ScreenUpdating = False



'Seleciona a guia Extract do Excel depois a célula A1
Sheets("Extract").Select
Range("A1").Select

'Iniciar exportação txt via Print com texto exato mostrado em tela sem erro das aspas

Dim Path As String
Dim FileNumber As Integer
Dim LR As Integer
Dim LC As Integer

Dim k As Integer
Dim i As Integer

LR = Worksheets("Extract").Cells(Rows.Count, 1).End(xlUp).Row
LC = Worksheets("Extract").Cells(1, Columns.Count).End(xlToLeft).Column

Path = ThisWorkbook.Path & "\Extract " & Format(Now(), "ddmmyyyy-hhmmss") & ".txt"
FileNumber = FreeFile

Open Path For Output As FileNumber

For k = 1 To LR

For i = 1 To LC

If i <> LC Then
Print #FileNumber, Cells(k, i),
Else
Print #FileNumber, Cells(k, i)
End If

Next i

Next k

Close FileNumber


' Caso deseja abrir o notepad imediatamente para conferir o txt gerado só retirar a linha comentada abaixo:


'Shell "notepad.exe " & Path, vbNormalFocus



Application.ScreenUpdating = True

MsgBox "Extract*.txt salvo na pasta onde abriu este Excel!"

End Sub





********************************************



Algumas pessoas sugerem a solução abaixo onde se coloca o xlTextPrinter, porém aqui para mim não resolveu nada, o melhor usado neste exemplo foi o xlTextWindows porém em algumas planilhas ele continuava trazendo aspas em algumas linhas, quando eu terminar meus estudos provavelmente vou entender por que disso......

Código VBA ruim mas que funcionou em 90% dos meus casos:







Sub Exportar_TXT()



Application.ScreenUpdating = False



'Seleciona a guia Extract do Excel depois a célula A1
Sheets("Extract").Select
Range("A1").Select



'Iniciar exportação txt via comando "salvar como"

Dim lWorkBook As Workbook
Dim lPlan As Worksheet

Set lWorkBook = Workbooks.Add

Extract.Copy Before:=lWorkBook.Sheets(1)

lWorkBook.SaveAs FileName:= _
ThisWorkbook.Path & "\Extract " & Format(Now(), "ddmmyyyy-hhmmss") & ".txt", _
FileFormat:=xlTextPrinter, CreateBackup:=False

lWorkBook.Close SaveChanges:=False

MsgBox "Extract*.txt salvo na pasta onde abriu este Excel!"

Sair:
Set lWorkBook = Nothing



End Sub










Fonte do meu código VBA:

https://www.wallstreetmojo.com/vba-write-text-file/

Citar Editar