[Resolvido]importação de arquivos TXT em sequência para Access com codigo VBA

Boa noite caros amigos, sou bastante inexperiente ainda com o Access e também com o VBA, venho através deste canal para solicitar ajuda pois estou tendo problemas para concluir um trabalho, o código abaixo consegui fazer para que ocorra a importação de arquivos texto que se encontra funcionando com sucesso, porem é feito um arquivo por vez, o que realmente era a necessidade no momento, porem agora em outra tarefa necessito processar mais de 500 arquivos textos em sequencia, gostaria de uma ajuda com o código abaixo para que eu consiga processar vários arquivos textos em sequencia. Desde já agradeço a todos e peço desculpas caso já exista tal duvida solucionada.

Código do Formulário onde é possível localizar o arquivo e seleciona-lo.

Private Sub Comando11_Click()
On Error GoTo Err_cmd_Arquivo_Click

Dim endereco As String
Dim abrirArquivo As New CommonDialog

endereco = abrirArquivo.GetOpenFile(Me.hWnd, "Selecione o arquivo a ser importado", "D:\Bancos de Dados\arquivos")
If Len(endereco) > 0 Then
txt_Arquivo = endereco
Else
txt_Arquivo = vbNullString
End If


Me.Recalc
Me.Repaint
Me.Requery

Exit_cmd_Arquivo_Click:
Exit Sub
Err_cmd_Arquivo_Click:
MsgBox Err.Description, vbCritical + vbOKOnly, "Nº Erro - " & Err.Number
Resume Exit_cmd_Arquivo_Click
End Sub


Código onde o arquivo selecionado é processado e importado

Private Sub Comando12_Click()
On Error GoTo TrataErro

Dim DB As DAO.Database
Dim RS As DAO.Recordset
Dim RS1 As DAO.Recordset
Dim Linha As String


If Len(Me.txt_Arquivo & vbNullString) = 0 Then ' Testa se txtNomeArq contém alguma coisa
MsgBox "Informe o nome do arquivo a ser importado", vbExclamation + vbOKOnly, "Vazio"
Me.txt_Arquivo.SetFocus
Exit Sub
End If
If Len(Dir(Me.txt_Arquivo)) = 0 Then ' Testa a existência do arquivo
MsgBox "O arquivo não existe!!!", vbCritical + vbOKOnly, "Erro"
Me.txt_Arquivo.SetFocus
Exit Sub
End If

Open Me.txt_Arquivo For Input As #1 ' Abre o arquivo a ser importado
If MsgBox("Deseja importar a lista de Arquivo?", vbQuestion + vbYesNo, "Sistema!") = vbYes Then


Set DB = CurrentDb
Set RS = DB.OpenRecordset("tbl_retorno")


While Not EOF(1)
Line Input #1, Linha ' Lê uma linha do arquivo texto
If Left$(Linha, 1) = "F" Then
With RS
.AddNew
!codigo = Mid$(Linha, 1, 1)
!identificador = Mid$(Linha, 2, 25)
!nome = Mid$(Linha, 27, 4)
!identificacao2 = Mid$(Linha, 31, 14)
!Data = Mid$(Linha, 45,
!valor = CStr(Mid$(Linha, 53, 15) / 100)
!codigo2 = Mid$(Linha, 68, 2)
!uso_livre = Mid$(Linha, 70, 70)
!reservado = Mid$(Linha, 140, 10)
.Update

End With

End If
Wend


Saida:
Close
Set RS = Nothing
Set DB = Nothing
MsgBox "Importação realizada com sucesso!", vbInformation, "Sistema!"
Exit Sub

TrataErro:
MsgBox Err.Description, vbExclamation + vbOKOnly, "Erro: " & CStr(Err.Number)
#If DESENV Then ' Compilação condicional - Em desenvolvimento
Stop
Resume
#End If
Resume Saida
End If
End Sub

Boa tarde, dilimaskywalker, e bem-vindo ao fórum
O código que publicou, abre uma pasta para escolher o ficheiro a importar
Tem os vários ficheiros (e apenas esses) na mesma pasta?

Alexandre é isso mesmo, ele ira buscar sempre somente nesta pasta.
obrigado

Boa tarde,
Private Sub Comando12_Click()
On Error GoTo TrataErro

Dim DB As DAO.Database
Dim RS As DAO.Recordset
Dim Linha As String
Dim objFileSys,objFolder

Set objFileSys = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFileSys.GetFolder(ColoqueAquiOEndereçoDaPasta)
Set DB = CurrentDb
Set RS = DB.OpenRecordset("tbl_retorno")

For Each objFile In objFolder.Files
Open objFile.Name For Input As #1 ' Abre o arquivo a ser importado
'If MsgBox("Deseja importar a lista de Arquivo?", vbQuestion + vbYesNo, "Sistema!") = vbYes Then

While Not EOF(1)
Line Input #1, Linha ' Lê uma linha do arquivo texto
If Left$(Linha, 1) = "F" Then
With RS
.AddNew
!codigo = Mid$(Linha, 1, 1)
!identificador = Mid$(Linha, 2, 25)
!nome = Mid$(Linha, 27, 4)
!identificacao2 = Mid$(Linha, 31, 14)
!Data = Mid$(Linha, 45,
!valor = CStr(Mid$(Linha, 53, 15) / 100)
!codigo2 = Mid$(Linha, 68, 2)
!uso_livre = Mid$(Linha, 70, 70)
!reservado = Mid$(Linha, 140, 10)
.Update

End With

End If
Wend
Next

Saida:
Close
Set RS = Nothing
Set DB = Nothing
MsgBox "Importação realizada com sucesso!", vbInformation, "Sistema!"
Exit Sub

TrataErro:
MsgBox Err.Description, vbExclamation + vbOKOnly, "Erro: " & CStr(Err.Number)
#If DESENV Then ' Compilação condicional - Em desenvolvimento
Stop
Resume
#End If
Resume Saida
'End If
End Sub

Valeu Alexandre vou testar a nova adaptação.
Muito Obrigado

Alexandre,
inseri o codigo e o caminho dos arquivos, porem ele esta importando somente o primeiro arquivo salvo na pasta e quando ele termina a importação do primeiro arquivo, ao voltar no loop ele apresenta a mensagem de erro o arquivo ja foi aberto.

Boa noite,
Só testando os ficheiros. Disponibilize-os

Conforme solicitado, segue ficheiro com alguns exemplos dos arquivos que desejo importa-los, todos de uma so vez.
Valeu Alexandre, Muito Obrigado

Perdão Alexandre, não estou conseguindo anexar o ficheiro, sempre ocorre a mensagem de erro O arquivo adicionado não é valido, tentei em varios formatos ate somente o .TXT a falha se repete, o tamanho também esta padrão, teria alguma outra forma que eu possa encaminha-lo?

ja tentou colocar dentro de uma pasta .zip?

segue arquivo como solicitado, tinha tentado antes com ele zipado, agora consegui nao sei porquer rsrs, mas ajuda valeu

você pode ter colocado ao inves de .zip como .rar, e o forum não reconhece.

Boa tarde,
Os ficheiros não estão em formato que sejam importados.

Os arquivos em questão, deverão ser abertos como .txt, porem eu estou anexando os mesmos arquivos já em txt, para facilitar.

Boa tarde,
Private Sub Comando12_Click()
On Error GoTo TrataErro

Dim DB As DAO.Database
Dim RS As DAO.Recordset
Dim Linha As String
Dim objFileSys,objFolder

Set objFileSys = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFileSys.GetFolder(ColoqueAquiOEndereçoDaPasta)
Set DB = CurrentDb
Set RS = DB.OpenRecordset("tbl_retorno")

For Each objFile In objFolder.Files
Open "ColoqueAquiOEndereçoDaPasta\" & objFile.Name For Input As #1 ' Abre o arquivo a ser importado
'If MsgBox("Deseja importar a lista de Arquivo?", vbQuestion + vbYesNo, "Sistema!") = vbYes Then

While Not EOF(1)
Line Input #1, Linha ' Lê uma linha do arquivo texto
If Left$(Linha, 1) = "F" Then
With RS
.AddNew
!codigo = Mid$(Linha, 1, 1)
!identificador = Mid$(Linha, 2, 25)
!nome = Mid$(Linha, 27, 4)
!identificacao2 = Mid$(Linha, 31, 14)
!Data = Mid$(Linha, 45,
!valor = CStr(Mid$(Linha, 53, 15) / 100)
!codigo2 = Mid$(Linha, 68, 2)
!uso_livre = Mid$(Linha, 70, 70)
!reservado = Mid$(Linha, 140, 10)
.Update

End With

End If
Wend
Close #1
Next

Saida:
Close
Set RS = Nothing
Set DB = Nothing
MsgBox "Importação realizada com sucesso!", vbInformation, "Sistema!"
Exit Sub

TrataErro:
MsgBox Err.Description, vbExclamation + vbOKOnly, "Erro: " & CStr(Err.Number)
#If DESENV Then ' Compilação condicional - Em desenvolvimento
Stop
Resume
#End If
Resume Saida
'End If
End Sub

Alexandre, muito obrigado pela ajuda, os arquivos estão sendo importados com sucesso!!!
Valeu