ATENÇÃO NOVOS USUÁRIOS

Se registrou recentemente? Seu cadastro será avaliado e mendiante aprovação, a conta será ativada e você poderá usufruir do fórum. O tempo de avaliação gira em torno de 24 a 48 horas.

Esqueceu sua senha?

Você pode usar o mecanismo de lembrete neste link: Recuperar senha

Você receberá um link de reativação no email cadastrado.

Não recebeu o email? Lembre-se checar o Lixo Eletrônico.

Importar vários TXT em abas no EXCEL via VBA

Fórum para dúvidas sobre os fundamentos da linguagem de programação Visual Basic no contexto do VBA
esteves.arthur
Acabou de chegar
Acabou de chegar
Mensagens: 8
Registrado em: Qua Nov 04, 2020 1:29 pm

Importar vários TXT em abas no EXCEL via VBA

Mensagem por esteves.arthur »

Boa tarde! Pessoal, sou novo em VBA. Consegui com muito custo um código que lê o arquivo selecionado, traz ele bonitinho e ainda coloca o nome do TXT na aba, ou seja, funciona para um único arquivo. Contudo eu preciso selecionar vários arquivos. Tentei o MultiSelect e deu muito ruim. Fora que eu tentei colocar o While para fazer o mesmo processo junto com o multiselect e so deu erro. Conseguem me dar uma luz?

Option Explicit

Sub ImportarTXT()
Dim FilePath As String
Dim WorksheetName As String
Dim ws As Worksheet
Dim FileNameParts() As String

FilePath = BrowseFilePath("Arquivos do Text,*.txt", "Selecione os arquivos")
If FilePath = "" Then Exit Sub

Set ws = ActiveSheet
ws.Cells.Delete
With ws.QueryTables.Add(Connection:="TEXT;" & FilePath, _
Destination:=Range("A1"))
.TextFileTabDelimiter = True
.Refresh BackgroundQuery:=False
.Delete
End With

FileNameParts = Split(FilePath, "\")
WorksheetName = FileNameParts(UBound(FileNameParts))
WorksheetName = Left(WorksheetName, InStrRev(WorksheetName, ".") - 1)
ws.Name = WorksheetName

End Sub

Private Function BrowseFilePath(pFileFilter As String, pTitle As String) As String
Dim FilePath As String

FilePath = CStr(Application.GetOpenFilename(FileFilter:=pFileFilter, Title:=pTitle))
If FilePath = CStr(False) Then GoTo Quit

BrowseFilePath = FilePath
Quit:
End Function


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Responder