Ler vários arquivos texto no Excel

Download do Arquivo

Só para dar uma explicação para quem acompanha este blog diariamente, ontem eu não pude realizar um post porque a minha internet estava fora.

Seguindo a linha dos posts de leitura e gravação de arquivos texto que eu estou fazendo, este é pra solucionar o problema de um amigo da comunidade Microsoft Excel que queria preencher a coluna B com uma lista de valores dividida em vários arquivos Txt.

Por exemplo na coluna A1 = 144, retornar a informação da linha 144 do arquivo que estiver sendo lido, sendo que se quiser retornar a linha 1545 e no arquivo 1 só tiverem 1000 linhas, a procedure continua e abre o próximo arquivo texto e retorna a linha 545.

Abaixo o código fonte:

Sub LerVariosArquivosTexto()
    On Error GoTo TratarErro

    Dim lsCaminho       As String
    Dim llArquivo       As Long
    Dim llLinha         As String
    Dim lQtde           As Long
    Dim lContador       As Long
    Dim llPlanilhas     As Long
    Dim lRange          As Range
    Dim iTotalLinhas    As Long
    Dim lLinhaAtual     As Long
    Dim lLocalizar      As Long
    Dim lTotal          As Long
    Dim lContaArquivo   As Long

    'Local do arquivo
    lsCaminho = InputBox("Digite o diretório do arquivo:", "Caminho do aruivo...", ActName)

    'Total de linhas
    iLinhaFinal = Cells(Rows.Count, 1).End(xlUp).Row
    iTotalLinhas = Cells(Rows.Count, 1).End(xlUp).Value

    'Verifica se o diretório existe e identifica o primeiro arquivo
    If Dir(lsCaminho & "\lista1.txt")  "" Then
        llArquivo = FreeFile

        lContador = 1
        lLinhaAtual = 1
        lContaArquivo = 1

        lLocalizar = Cells(lLinhaAtual, 1).Value

        'Loop das células
        While lContador <= iTotalLinhas
            Open lsCaminho & "\lista" & CStr(lContaArquivo) & ".txt" For Input As #llArquivo

            'Loop dos arquivos
            While Not EOF(llArquivo)

                Line Input #llArquivo, llLinha

                If lContador = lLocalizar Then
                    Cells(lLinhaAtual, 2).Value = llLinha

                    If lLinhaAtual < iLinhaFinal Then
                        lLinhaAtual = lLinhaAtual + 1
                        lLocalizar = Cells(lLinhaAtual, 1).Value
                    Else
                        GoTo Sair
                    End If
                End If
                lContador = lContador + 1
            Wend
            Close #llArquivo
            lContaArquivo = lContaArquivo + 1
        Wend
    Else
        MsgBox "Arquivo não encontrado!"
    End If

Sair:
    Close #llArquivo
    Exit Sub
TratarErro:
    MsgBox "Houve um erro na leitura do arquivo!"
    GoTo Sair
    Resume
End Sub

Então é isso pessoal, se tiverem dúvidas ou problemas em Excel podem enviar que farei o possível para ajudar.

Marcos Rieper