Excel Importar txt com tabulação de diretório e salvar como xls em diretório

[Diegodcr]

Tenho vários arquivos .txt no diretório c:\txt e preciso importar individualmente para o excel salvando individualmente com o nome de cada arquivo txt no formato .xls no diretório c:\xls

Em anexo tem os arquivos txt com os dados a serem importados e os arquivos xls de como devem ficar.

1.txt 2.txt 3.txt 3.xls 2.xls 1.xls

[Wendell Menezes]

Experimente essa macro:

 

Sub CONVERT_TXT()

Const PathTXT As String = "C:\Users\PC\Downloads\" 'Diretório dos .TXT (com "\" no fim!)
Const PathXLS As String = "C:\Users\PC\Downloads\" 'Diretório dos .XLS (com "\" no fim!)

Dim FSO     As Object
Dim File    As Object
Dim wb      As Workbook

Application.DisplayAlerts = False

Set FSO = VBA.CreateObject("Scripting.FileSystemObject")

For Each File In FSO.GetFolder(PathTXT).Files
    If Right(LCase(File), 4) = ".txt" Then
        Set wb = Workbooks.Open(File)
        wb.SaveAs PathXLS & Replace(LCase(wb.Name), ".txt", ".xls")
        wb.Close False
    End If
Next

End Sub

 

[Diegodcr]

@Wendell Menezes  Não da certo pois apresenta a msg anexada.

[Wendell Menezes]

E se você clica em Sim, não abre o arquivo?

De qualquer maneira, altere essa linha do código, acrescentando , xlWorkbookNormal no fim":

 

wb.SaveAs PathXLS & Replace(LCase(wb.Name), ".txt", ".xls"), xlWorkbookNormal

 

[Diegodcr]

@Wendell Menezes Se eu clicar em Sim o arquivo abre porém fica ruim pois são 400 arquivos e de qualquer forma o seu último código ficou perfeito.

 

Se for de sua boa vontade e puder ajudar, toda guia da planilha convertida pra xls tem que ter o nome "plan1" ao invés do nome do arquivo txt

 

[Wendell Menezes]

Claro, ficaria assim:

 

Sub CONVERT_TXT()

Const PathTXT As String = "C:\Users\PC\Downloads\" 'Diretório dos .TXT (com "\" no fim!)
Const PathXLS As String = "C:\Users\PC\Downloads\" 'Diretório dos .XLS (com "\" no fim!)

Dim FSO     As Object
Dim File    As Object
Dim wb      As Workbook

Application.DisplayAlerts = False

Set FSO = VBA.CreateObject("Scripting.FileSystemObject")

For Each File In FSO.GetFolder(PathTXT).Files
    If Right(LCase(File), 4) = ".txt" Then
        Set wb = Workbooks.Open(File)
        ActiveSheet.Name = "Plan1"
        wb.SaveAs PathXLS & Replace(LCase(wb.Name), ".txt", ".xls"), xlWorkbookNormal
        wb.Close False
    End If
Next

End Sub

 

[Diegodcr]

@Wendell Menezes Ficou TOP!!

Muito obrigado e que seja de ajuda para mais pessoas!

[Tarciso Silva]

Olá amigos,

No caso aqui citado a macro está gravando um arquivo para cada txt. É possível gravar em apenas uma Pasta de Trabalho do Excel sendo cada txt como uma aba (planilha) dentro dessa pasta?

Podem me ajudar?