Loop para importar arquivos .txt

Boa tarde.

Tenho um total de 15 códigos e 15 pastas nomeadas com esses códigos onde são armazenadas informações referentes á esses códigos.

Os códigos são esses:

5000216
5000226
5001982
5002144
5002337
5002353
5002519
5002522
5002529
5002626
5002656
5002743
5002975
5003013
5003014

Eu extraio individualmente (código por código) do SAP um relatório em .txt e o salvo dentro da pasta referente ao código extraído. O arquivo tem sempre o nome do relatório, mais o código extraído e data da extração. Ex: FBL2N 5000216 01.07.2011.txt.
Após ter feito isso para todos os códigos, importo o relatório .txt para o Excel e o salvo na mesma pasta onde está o arquivo .txt. O arquivo Excel é salvo e nomeado da mesma maneira que o arquivo .txt. Ex: FBL2N 5000216 01.07.2011.xlsm

Criei uma macro através do gravador que realiza a importação do arquivo .txt para o Excel. Segue abaixo:

Sub Importar()

Range("A1").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Documents and Settings\dasilas\Meus documentos\KR 9Z\5000216\FBL2N 5000216 01.07.2011.txt" _
, Destination:=Range("$A$1"))

'C:\Documents and Settings\dasilas\Meus documentos = Meu diretório
'KR 9Z = Pasta mãe
'5000216 = Sub pasta (5000216 é o código do fornecedor que por sua vez é o nome da pasta)
'FBL2N 5000216 01.07.2011.txt = Nome do arquivo .txt
.Name = "FBL2N 5000216 01.07.2011"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, _
2, 2, 2, 2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False

End With

End Sub

Estou a utilizando essa macro da seguinte maneira: Realizo a importação para um código e após o término, edito a macro atualizando manualmente a parte referente ao código com o próximo código a ser importado.

Dúvida: teria como criar um loop para realizar a importação e salvar o arquivo dentro de suas pastas para todos os códigos sem a necessidade de ter que editar manualmente a macro ?

Obrigado.

Bom dia,
Acredito que este código deve atendê-lo:

Código:

Sub ImportarTxt()

Dim Arquivo    As String
Dim k          As Integer
Dim DataRef
Dim ListCod


'Informar a data na qual os arquivos foram gerados
'Pode ser digitada diretamente ou informada uma referência de célula
DataRef = Application.InputBox(Prompt:="Informe a data de referência da importação, no formato dd.mm.aaaa", _
Type:=10)

'Lista de códigos dos fornecedores
ListCod = Array("0216", "0226", "1982", _
"2144", "2337", "2353", "2519", "2522", "2529", _
"2626", "2656", "2743", "2975", "3013", "3014")

'Loop para percorrer os elementos do vetor ListCod
For k = LBound(ListCod) To UBound(ListCod)

'Definir o arquivo a ser aberto
Arquivo = "C:\Documents and Settings\dasilas\Meus documentos\KR 9Z\500" & ListCod(k) & _
"\FBL2N 500" & ListCod(k) & vbspace & DataRef

Range("A1").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & Arquivo & ".txt" _
, Destination:=Range("$A$1"))

'C:\Documents and Settings\dasilas\Meus documentos = Meu diretório
'KR 9Z = Pasta mãe
'5000216 = Sub pasta (5000216 é o código do fornecedor que por sua vez é o nome da pasta)
'FBL2N 5000216 01.07.2011.txt = Nome do arquivo .txt
.Name = "FBL2N 500" & ListCod(k) & vbspace & DataRef
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, _
1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False

End With

'Fechar o arquivo e salvando as alterações realizadas como um arquivo xlsm
ActiveWorkbook.Close SaveChanges:=True, Filename:=Arquivo & ".xlsm"

Next k

End Sub

Bom dia Adilson !

Desde já quero agradece-lo pelo retorno. Testarei o código e em breve informarei o resultado.

Um grande abraço e novamente, obrigado.

Olá.

Adilson, o código não está localizando o arquivo .txt. Estou tentando indentificar o motivo, porém, até o presente momento, as minhas tentativas não foram satisfatórias.

A linha que está apresentando o erro é essa: .Refresh BackgroundQuery:=False

Descrição do erro:

"O Excel não pode encontrar o arquivo de texto para atualizar esse intervalo de dados externos.
Certifique-se de que o arquivo de texto não tenha sido movido ou renomeado e, em seguida, tente a atualização novamente."

Obrigado.

Olá, meu caro.
Utilize a versão do código abaixo.
O erro é que utilizei uma constante vbSpace para inserir um espaço e que na verdade não existe. Corrigi, substituindo por Space(1).
Isso fazia que o nome do arquivo fosse algo como:
C:\Documents and Settings\dasilas\Meus documentos\KR 9Z\5000216\FBL2N 500021612.07.2011
Ao invés de:
C:\Documents and Settings\dasilas\Meus documentos\KR 9Z\5000216\FBL2N 5000216 12.07.2011
Peço que teste novamente e me conte os resultados

Código:


    Sub ImportarTxt()

    Dim Arquivo    As String
    Dim k          As Integer
    Dim DataRef
    Dim ListCod


    'Informar a data na qual os arquivos foram gerados
    'Pode ser digitada diretamente ou informada uma referência de célula
    DataRef = Application.InputBox(Prompt:="Informe a data de referência da importação, no formato dd.mm.aaaa", _
    Type:=10)

    'Lista de códigos dos fornecedores
    ListCod = Array("0216", "0226", "1982", _
    "2144", "2337", "2353", "2519", "2522", "2529", _
    "2626", "2656", "2743", "2975", "3013", "3014")

    'Loop para percorrer os elementos do vetor ListCod
    For k = LBound(ListCod) To UBound(ListCod)

    'Definir o arquivo a ser aberto
    Arquivo = "C:\Documents and Settings\dasilas\Meus documentos\KR 9Z\500" & ListCod(k) & _
    "\FBL2N 500" & ListCod(k) & Space(1) & DataRef

    Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
    "TEXT;" & Arquivo & ".txt" _
    , Destination:=Range("$A$1"))

    'C:\Documents and Settings\dasilas\Meus documentos = Meu diretório
    'KR 9Z = Pasta mãe
    '5000216 = Sub pasta (5000216 é o código do fornecedor que por sua vez é o nome da pasta)
    'FBL2N 5000216 01.07.2011.txt = Nome do arquivo .txt
    .Name = "FBL2N 500" & ListCod(k) & Space(1) & DataRef
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 1252
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = True
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = False
    .TextFileSpaceDelimiter = False
    .TextFileOtherDelimiter = "|"
    .TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, _
    1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False

    End With

    'Fechar o arquivo e salvando as alterações realizadas como um arquivo xlsm
    ActiveWorkbook.Close SaveChanges:=True, Filename:=Arquivo & ".xlsm"

    Next k

    End Sub


Abraços

Olá Adilson !

Eu não conhecia a constante "vbSpace". Eu pensei que fosse ela quem estava inserindo o " " no nome do arquivo, jamais eu poderia imaginar que era esse o motivo do arquivo não ser localizado.

Então, o código ainda não está funcionando conforme o esperado. Veja só:

1º. Não entendi o motivo, mas o registro que está sendo importado é o arquivo referente á minha penúltima pasta, ou seja, o código está buscando na pasta 5003013 o arquivo FBL2N 5003013 01.07.2011.txt. A importação acontece corretamente, mas acredito que o correto seria começar a importação pelo primeiro registro encontrado ( Menor para maior ).

2º. Após importar o arquivo, o código fecha o arquivo e o salva no formato .xlsm no diretório correto, porém, o loop não continua a ser executado, ou seja, a importação acontece apenas para o penúltimo código da lista.

Será que o problema está com a função LBound e UBound ? Me parece que o programa está se perdendo no momento em que determina a matriz...

Bom, mas enfim, estou gostando, o código está ficando muito bom ! Continuarei aqui "quebrando a cabeça" tentando entender o código que tu criastes. rsrsrsrs

Novamente, muito obrigado.

Abraços.

Bom dia, meu caro.
Vamos aos esclarecimentos:
LBound e UBound definem respectivamente o ordinal do primeiro e do último elemento de uma matriz. No nosso caso LBound(ListCod) = 0 e UBound(ListCod) = 14. Prefiro escrever os códigos utilizando este comando, pois, dependo da configuração (Option Base), o ordinal inicial poderá ser zero ou um.
Desta forma, o loop realiza a abertura dos arquivos na sequência ListCod(0) ("0216") até ListCod(14) ("3014")
Criei uma estrutura de pastas similar à que você descreveu e, no meu caso, os arquivos foram abertos e salvos na sequência correta.
A versão do código a seguir, não abre os arquivos, mas via permitir que você verifique se há algum erro nos nomes para identificar os erros.
Peço que faça essa verificação e depois me conte os resultados.

Código:


Sub ListarTxt()

    Dim Arquivo    As String
    Dim k          As Integer
    Dim DataRef
    Dim ListCod


    'Informar a data na qual os arquivos foram gerados
    'Pode ser digitada diretamente ou informada uma referência de célula
    DataRef = Application.InputBox(Prompt:="Informe a data de referência da importação, no formato dd.mm.aaaa", _
    Type:=10)

    'Lista de códigos dos fornecedores
    ListCod = Array("0216", "0226", "1982", _
    "2144", "2337", "2353", "2519", "2522", "2529", _
    "2626", "2656", "2743", "2975", "3013", "3014")

    'Inserir uma nova planilha para armazenar a listagem dos arquivos
    ThisWorkbook.Sheets.Add
   
    'Loop para percorrer os elementos do vetor ListCod
    For k = LBound(ListCod) To UBound(ListCod)

    'Definir o arquivo a ser aberto
    Arquivo = "C:\Documents and Settings\dasilas\Meus documentos\KR 9Z\500" & ListCod(k) & _
    "\FBL2N 500" & ListCod(k) & Space(1) & DataRef

    Cells(k + 1, 1) = Arquivo & ".txt"
   
    Next k

End Sub




[ ]s

Olá Adilson, boa tarde ! Tudo bem ? Espero que sim.

Obrigado por explicar as funções LBound e UBound. Agora ficou claro...

Bom, executei o código que tu me passou e realmente existia um arquivo nomeado incorretamente, era esse o motivo de ocorrer falha no momento da importação.

Agora o código desenvolvido por ti está importando e salvando corretamente o arquivo .txt como .xlsm, porém, o loop não está funcionando, ou seja, apenas a importação referente ao primeiro código de fornecedor é executada. Após a importação, o arquivo é fechado e o código não executa a instrução Next k...

Muito obrigado.

Abraços.

Identifiquei o problema: o txt está sendo importado para o próprio arquivo e portanto quando é solicitado o fechamento do Activeworkbook é fechado o arquivo que contém a macro.
Alterei o código para que a cada iteração seja criado um novo arquivo e a partir deste é feito o salvamento do arquivo xlsm.
Veja se está ok agora. Caso não esteja continuaremos até dar certo.

Código:


Sub ImportarTxt()

    Dim Arquivo    As String
    Dim k          As Integer
    Dim DataRef
    Dim ListCod


    'Informar a data na qual os arquivos foram gerados
    'Pode ser digitada diretamente ou informada uma referência de célula
    DataRef = Application.InputBox(Prompt:="Informe a data de referência da importação, no formato dd.mm.aaaa", _
    Type:=10)

    'Lista de códigos dos fornecedores
    ListCod = Array("0216", "0226", "1982", _
    "2144", "2337", "2353", "2519", "2522", "2529", _
    "2626", "2656", "2743", "2975", "3013", "3014")

    'Loop para percorrer os elementos do vetor ListCod
    For k = LBound(ListCod) To UBound(ListCod)

    'Definir o arquivo a ser aberto
    Arquivo = "C:\Documents and Settings\dasilas\Meus documentos\KR 9Z\500" & ListCod(k) & _
    "\FBL2N 500" & ListCod(k) & Space(1) & DataRef
    'Inserir um novo arquivo que receberá as informações do txt
    Workbooks.Add
   
    Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
    "TEXT;" & Arquivo & ".txt" _
    , Destination:=Range("$A$1"))

    'C:\Documents and Settings\dasilas\Meus documentos = Meu diretório
    'KR 9Z = Pasta mãe
    '5000216 = Sub pasta (5000216 é o código do fornecedor que por sua vez é o nome da pasta)
    'FBL2N 5000216 01.07.2011.txt = Nome do arquivo .txt
    .Name = "FBL2N 500" & ListCod(k) & Space(1) & DataRef
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 1252
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = True
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = False
    .TextFileSpaceDelimiter = False
    .TextFileOtherDelimiter = "|"
    .TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, _
    1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False

    End With

    'Fechar o arquivo e salvando as alterações realizadas como um arquivo xlsm
    ActiveWorkbook.Close SaveChanges:=True, Filename:=Arquivo & ".xlsm"

    Next k

End Sub


[ ]s

Olá Adilson ! Ainda não consegui testar o código mais recente que tu criou, pois estou em fechamento e então tu pode imaginar como é, né ? Agora estou indo embora, pois nas sextas feiras, trabalhamos até as 16:30, porém, enviei alguns arquivos para casa e assim que eu chegar realizarei os testes.

Novamente, muito obrigado pela força e pela atenção disponibilizada.

Abraços.

Bom dia Adilson, tudo bem ? Espero que sim.

Adilson, o código ficou perfeito ! Nem sei como te agradecer ! Sensacional !

Eu alterei a parte em que o código salva o arquivo como ".xlsm" para ".xlsx". Fiz isso porque o comando "Workbooks.Add" adiciona no formato ".xlsx" e quando o código tenta salvar o arquivo como ".xlsm" dá erro, pois os formatos são incompatíveis, então alterei para ".xlsx" e deu tudo certo, ou seja, os 15 arquivos foram importados e salvos com sucesso !

Novamente, muito obrigado e que Deus abençõe tu e toda a sua família.



Um grande abraço.

Não tem de quê, meu caro.
Fico feliz em saber que ajudei a acelerar o teu trabalho.
Foi justamente devido a um problema similar que iniciei meu aprendizado no VBA. Minha primeira macro fazia os ajustes de um relatório de sistema ERP e, na sequência, aprendi a fazer o loop para ajustar os 20 arquivos que eram gerados. A partir daí foi um passo de cada vez para buscar cada vez mais conhecimento sobre o assunto.

Um abração e até a próxima

Sim Adilson ! Isso ajudará muito no meu trabalho, pois essas importações são feitas manualmente ! Ganharei muito tempo utilizando esse código que tu criou.
Caso um dia tu vier para Joinville, me avise, pois faço questão de pagar ao menos um chopp p/ ti ! rsrs

Até mais.

Vou perder este chope por pouco...
Dia 14 vou para o RS ficar uma semana...
Preciso agendar alguma coisa para SC, para poder te cobrar pessoalmente...rsrsrs.
Abração!