[Resolvido]Importação massiva de arquivos TXT via código vba ou macros.

Prezados, Boa Tarde!

Alguem conhece algum código em vba que possibilite a importação massiva de varios arquivos txt para uma tabela específica? Sei que posso agrupar os arquivos .txt via .bat.
A situação é a seguinte, tenho algumas pastas na rede onde as mesmas são alimentadas diariamente por vários arquivos txt, atualmente utilizo arquivos .bat para agrupa-los.

Alguem tem alguma sugestão de como importar os mesmo de forma massiva via vba ou macro?

Grato pelo Apoio.

Option Compare Database
Option Explicit

'------------------------------------------------------------------------------
' Procedure: subImport
' Author: Dave Swanton
' Purpose: Read in new data file from an txt file
' Dependencies: None
' Parameters: None
'-------------------------------------------------------------------------------



Public Sub subImport()
On Error GoTo Err_subImport

Dim stDocName As String
Dim fs As FileSearch
Dim ifn As String
Dim sql As String
Dim today As String
Dim fso As Scripting.FileSystemObject
Dim oktogo As Boolean
Dim specname As String
Dim repdate As String
Dim myfile As Scripting.TextStream
Dim i As Long
Dim y As Integer
Dim ShortFn As String
Dim specname As String

specname = "Import Specs"
DoCmd.SetWarnings False
sql = "DELETE FROM tbl_temp_Import"

DoCmd.RunSQL sql 'Empty Temp Table



DoCmd.SetWarnings False
oktogo = False
ifn = CurrentProject.Path & "\Imports\"
Set fs = Application.FileSearch
With fs
.LookIn = ifn

.Filename = "*.txt"
If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) > 0 Then

For i = 1 To .FoundFiles.Count

ShortFn = Right(.FoundFiles(i), Len(.FoundFiles(i)) - InStrRev(.FoundFiles(i), "\"))
DoCmd.TransferText acImportDelim, specname, "tbl_temp_Import", .FoundFiles(i), True
subArchive .FoundFiles(i)
y = y + 1


Next i
Else
MsgBox "Please ensure that the source file is present and try again" & vbCr _
& "Required file location: " & vbCr & ifn, vbExclamation + vbOKOnly, "Input File Missing"


Exit Sub
End If
End With




MsgBox "Import complete. " & y & " files Imported", vbOKOnly + vbInformation, "Import Complete"

Exit_subImport:
' Turn warning messages back on
DoCmd.SetWarnings True

Exit Sub

Err_subImport:
MsgBox Err.Description
Resume Exit_subImport

End Sub


'------------------------------------------------------------------------------
' Procedure: subArchive
' Author: Dave Swanton
' Purpose: Archive Import files into Archived Imports Folder
' Dependencies: None
' Parameters: None
'-------------------------------------------------------------------------------


Public Sub subArchive(src As String)

On Error GoTo Err_subArchive
Dim dest As String
Dim fso As Scripting.FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")

dest = Left(src, InStrRev(src, "\")) & "\Archived repancy Files\" & Right(src, Len(src) - InStrRev(src, "\"))
If fso.FileExists(dest) Then
fso.DeleteFile dest
Name src As dest
Else
Name src As dest
End If
Exit_subArchive:
Exit Sub

Err_subArchive:
MsgBox Err.Description
Resume Exit_subArchive

End Sub

Nobre,

Pode ser mais específico? Encontrei dificuldades para enteder o exemplo.

Estou a puxar o tópico para cima.

Alguém mais tem alguma sugestão para o meu tema?

Conto com o apoio de todos.

Obrigado.

Detalhe melhor a questão. Você junta esses arquivos via bat. Certo, mas eles ficam unidos em um arquivo bat ou em um outro txt? Acredito que consigas fazer isso adaptando exemplos de tópicos já resolvidos.

Como não retornou, o tópico passa a resolvido. Qualquer coisa reabra, por favor.