2

Ola pessoal tenho esta macro para converter vários txt para excel, mas quando converte ele não separa o arquivo por coluna ";"

Sub Convert_Csv()

    Dim File_Names As Variant
    Dim File_count As Integer
    Dim Active_File_Name As String
    Dim Counter As Integer
    Dim File_Save_Name As Variant

    File_Names = Application.GetOpenFilename(, , , , True)
    File_count = UBound(File_Names)
    Counter = 1
    Do Until Counter > File_count
        Active_File_Name = File_Names(Counter)
        Workbooks.Open Filename:=Active_File_Name
        Active_File_Name = ActiveWorkbook.Name
        File_Save_Name = InStr(1, Active_File_Name, ".txt", 1) - 1
        File_Save_Name = Mid(Active_File_Name, 1, File_Save_Name) & ".xlsx"
        ActiveWorkbook.SaveAs Filename:=File_Save_Name,   FileFormat:=xlOpenXMLWorkbooklocal:=true
        ActiveWindow.Close
        Counter = Counter + 1
    Loop

End Sub

1 Resposta 1

1

Pelo que analisei o comando ActiveWorkbook.SaveAs não comporta ou não prevê a separação de texto por ponto e vírgula.

Como o que precisa é ter estes textos colocados na planilha com o tratamento do separador ";", a parte do código apresentada abaixo resolve.

With ActiveSheet.QueryTables.Add(Connection:= _
    "C:\Texto.txt", Destination:=Range("$A$1"))
    .Name = "TESTE"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 850
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = False
    .TextFileSemicolonDelimiter = True
    .TextFileCommaDelimiter = False
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(1, 1)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
End With

Após a leitura do arquivo texto que tem no teu código, adapte para passar os dados de caminho e nome, pois aqui eles estão fixos. É isso!

3
  • muito obrigado amigo vou testar mas de imediato fica grato Commented 16/07/2016 às 23:21
  • 1
    obrigado por me alertar sou novo por aqui Commented 18/07/2016 às 0:46
  • Valeu Marcio, que bom que funcionou! Tranquilo, na dúvida consulte a Ajuda e faça o Tour, é bem explicado.
    – Leo
    Commented 18/07/2016 às 0:46

Você deve fazer log-in para responder a esta pergunta.

Esta não é a resposta que você está procurando? Pesquise outras perguntas com a tag .