Abrindo multiplos arquivos de texto simultaneamente

[Evandrobob]

Boa tarde,

 

Sou novo programando VBA e ainda estou limitado a muitas ferramentas do programa. No momento estou tentando desenvolver através de macro e de algumas coisas que programei para tentar solucionar a seguinte situação:

Ao longo do dia recebo diversos arquivos de texto mais ou menos nesse formato, algumas informações a mais, porém se souber solucionar assim irei saber os demais

12345678#Joao Andante#Loja#?????12345678=12345678
12345678#Joao Andante#Loja#?????12345678=12345678
12345678#Joao Andante#Loja#?????12345678=12345678


Eu precisava bolar alguma coisa para que eu possa selecionar diversos arquivos ao mesmo tempo e realizar o processo de separar em colunas, da seguinte forma:

A1                   B1                        C1            D1
12345678       Joao Andante       Loja          12345678=12345678  (1o arquivo)

41231234       Maria Joana          Loja2        12412312=12312312 (2o arquivo - exemplo)

E assim por diante, e quando terminar esse arquivo, ele abrir o seguinte e continuar o processo em baixo até finalizar todos os arquivos selecionados.


Para fazer o hyperlink eu realizei o seguinte processo:

Eu criei um userform com as funções que irei utilizar, relatório, apagar dados, armazenar no banco, etc. e tal. Juntamente, criei uma caixa de texto e um botão, cujo vinculei uma macro que irá abrir a tela de busca do arquivo:

       With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & cxAbrir_TXT.cdCaminho, Destination:=Range("$A$1"))
        *// e então entra o restante da macro com o procedimento de importação de arquivo de texto, separando as colunas nos # //

Ai entra a pergunta novamente, como faço para abrir mais de um arquivo, pensei algo por exemplo quando se segura CTRL para selecionar vários arquivos, ou vocês sabem de algo que facilite ainda mais ?

[MatheusLPS]

Opa, como te falei no chat, tá aí o código. No final tem o arquivo para testes.

 

O código ficou extenso pois faz uma função muito legal. Você indica uma pasta e ele buscar todos os arquivos com a extensão que você quiser. Aqui, o filtro é .TXT. Mas pode ser vários filtros ao mesmo tempo.

 

Depois que ele localiza todos os arquivos em uma pasta, ele abre cada um e faz o que precisa ser feito. Nesse caso, separar o caracter # do restante.

 

Qualquer dúvida, pode perguntar que se estiver ao meu alcance, ajudo.

Sub Macro_by_Matheus_Lopes_67714()    Dim FList() As String    Dim pos As Integer    Dim pasta As String    Dim arquivo As String    Dim tamanho As Integer    Dim completo As String    Dim local_pesquisa As String        'Application.ScreenUpdating = False                     'Desabilita a atualização da tela. Bem útil.    local_pesquisa = Plan1.TextBox_local_pesquisa.Text    FList = FileList(local_pesquisa)        aux = UBound(FList)        linha = 1        For i = 0 To aux                'Application.StatusBar = "Abrindo e Salvando: " & i - 2 & " de " & aux & ": " & Format((i - 1) / aux, "0%")        pos = InStrRev(FList(i), "\")                       'Procura por "\" no final da string        tamanho = Len(FList(i))                             'Retorna o tamanho da string que contém o endereço comppleto do arquivo        If tamanho = 0 Then            MsgBox " Verifique local de pesquisa!"            Exit Sub        End If        arquivo = Right$(FList(i), tamanho - pos)           'Retorna somente o nome do arquivo com a extensão        pasta = Left$(FList(i), pos)                        'Retonra somente o nome da pasta onde o arquivo atual se encontra        Plan1.Cells(i + 1, 1) = pasta                       'Apenas para informação. A coluna A da Plan1 recebe o nome da pasta        Plan1.Cells(i + 1, 2) = arquivo                     'Apenas para informação. A coluna b da Plan1 recebe o nome do arquivo        completo = pasta & arquivo                          'Separei antes e vou juntar novamente. hahahahaaa :-)        'Application.ScreenUpdating = False                  'Desabilita a atualização da tela. Bem útil.                        Open completo For Input As #1                Do Until EOF(1)            Line Input #1, LineFromFile                        LineItems = Split(LineFromFile, "#")            Plan2.Cells(linha, 1).Value = LineItems(0)            Plan2.Cells(linha, 2).Value = LineItems(1)            Plan2.Cells(linha, 3).Value = LineItems(2)            Plan2.Cells(linha, 4).Value = LineItems(3)                        linha = linha + 1        Loop                Close #1    Next i        'Application.ScreenUpdating = True                  'Habilita a atualização da tela. Bem útil.End SubPublic Function FileStr(fldr As String, Optional fltr As String = "*.*") As String      'Função que retorna todos os arquivos    Dim Name As String, Path As String, List As String                                  'na pasta base    Dim files(10000) As String    Dim dirs(10000) As String    If Right$(fldr, 1) <> "\" Then fldr = fldr & "\"    f = 0    d = 0    Name = Dir(fldr & fltr, vbDirectory)    If Name = "" Then        FileStr = ""        MsgBox Plan1.TextBox_local_pesquisa.Text & " não existe!"        Exit Function    End If    Path = fldr + Name    If GetAttr(Path) = 16 Then        If Name <> "." And Name <> ".." Then            d = d + 1            dirs(d) = Path        End If    Else        f = f + 1        files(f) = Path    End If    Do        Name = Dir        If Name = "" Then Exit Do        Path = fldr + Name        If GetAttr(Path) = 16 Then            If Name <> "." And Name <> ".." Then                d = d + 1                dirs(d) = Path            End If        Else            If Name <> "." And Name <> ".." Then                f = f + 1                files(f) = Path            End If        End If    Loop    List = files(1)    For i = 2 To f        Path = files(i)        If List <> "" Then            If Path <> "" And Path <> "." And Path <> ".." Then List = List & "|" & Path        Else            If Path <> "" And Path <> "." And Path <> ".." Then List = Path        End If    Next i    i = 0    For i = 1 To d        Path = FileStr(dirs(i))        If List = "" Then            If Path <> "" Then List = Path        Else            If Path <> "" Then List = List & "|" & Path        End If    Next i    FileStr = ListEnd FunctionPublic Function FileList(fldr As String, Optional fltr As String = "*.*") As Variant    Dim s As String    Dim all_files As Variant    Dim filtro As String    s = FileStr(fldr, fltr)    If s = "" Then        FileList = Split("|", "|")        Exit Function    End If    all_files = Split(s, "|")    s = ""    '-------------------------------------------------------------------------------'|-->   Início da rotina que elina os arquivos que não são .TXT         <--|'-------------------------------------------------------------------------------        For i = 0 To UBound(all_files)        filtro = Right$(all_files(i), 4)        If filtro <> ".txt" Then            all_files(i) = ""        Else            If s = "" Then                s = all_files(i)            Else                s = s & "|" & all_files(i)            End If        End If    Next i    '-------------------------------------------------------------------------------'|-->   Fim da rotina que elina os arquivos que não são TXT            <--|'-------------------------------------------------------------------------------    FileList = Split(s, "|")                                    ' Separa a string    End Function

https://www.dropbox.com/s/x4sh923ozwsvbp4/Excel.rar

 

Falou

[Evandrobob]

Opa, muito obrigado Matheus!!!

Foi super atencioso e atendeu exatamente o que eu estava precisando resolver... e como resolveu ;P!!