How to loop through a folder? - ms-access

Question

I want to loop through a folder and import all the files into Access.
This is my code:
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fso, MyFile, FileName, TextLine
Dim TextArray()
Dim x As Double
Dim SQLString
Set fso = CreateObject("Scripting.FileSystemObject")
FileName = "C:\Users\ava\Desktop\TEST_IMPORT\1.txt"
Set MyFile = fso.OpenTextFile(FileName, ForReading)
Do While MyFile.AtEndOfStream <> True
ReDim Preserve TextArray(x)
TextLine = MyFile.ReadLine
TextArray(x) = TextLine
x = x + 1
Loop
MyFile.Close
SQLString = "INSERT INTO TEST_TAB (Layout, Anzahl_Etiketten, Anzahl_Verpackungseinheiten, Bezeichnung1, Selektionsnummer, Bezeichnung2, Barcode, LA_Nummer, RM_Nummer, Bezeichnung3, Teilenummer) VALUES ('" & TextArray(0) & "','" & TextArray(1) & "','" & TextArray(4) & "','" & TextArray(5) & "','" & TextArray(6) & "','" & TextArray(7) & "','" & TextArray(9) & "','" & TextArray(10) & "','" & TextArray(13) & "','" & TextArray(15) & "','" & TextArray(19) & "');"
DoCmd.SetWarnings (WarningsOff)
DoCmd.RunSQL SQLString
DoCmd.SetWarnings (WarningsOn)
End Sub
The code imports a text file from my desktop (1.txt) then imports the data into my Access DB.
This works for my one File. (1.txt)
I found this link how to loop through a folder.
How do I implement that into my code?

Answer 1

im assuming you are reading every file with extension .txt in the folder C:\Users\ava\Desktop.
Try this...
Dim TextArray()
Dim x As Double
Dim SQLString
Set fso = CreateObject("Scripting.FileSystemObject")
strFolder= "C:\Users\ava\Desktop" 'sets folder
strFileName = Dir(strFolder & "\*.txt") 'grabs first txt file
Do While strFileName <> 0 'starts loop
FileName = strFileName 'set filename
Set MyFile = fso.OpenTextFile(FileName, ForReading)
'' Read from the file
Do While MyFile.AtEndOfStream <> True
ReDim Preserve TextArray(x)
TextLine = MyFile.ReadLine
TextArray(x) = TextLine
x = x + 1
Loop
MyFile.Close
SQLString = "INSERT INTO TEST_TAB (Layout, Anzahl_Etiketten, Anzahl_Verpackungseinheiten, Bezeichnung1, Selektionsnummer, Bezeichnung2, Barcode, LA_Nummer, RM_Nummer, Bezeichnung3, Teilenummer) VALUES ('" & TextArray(0) & "','" & TextArray(1) & "','" & TextArray(4) & "','" & TextArray(5) & "','" & TextArray(6) & "','" & TextArray(7) & "','" & TextArray(9) & "','" & TextArray(10) & "','" & TextArray(13) & "','" & TextArray(15) & "','" & TextArray(19) & "');"
DoCmd.SetWarnings (WarningsOff)
DoCmd.RunSQL SQLString
DoCmd.SetWarnings (WarningsOn)
strFileName = Dir 'Grabs next txt file
Loop

Answer 2

I'm not sure why you are using TextArray over and over and over, but consider doing it like this.
Option Compare Database
Private Sub Command0_Click()
Dim strPathFile As String, strFile As String, strPath As String
Dim strTable As String
Dim blnHasFieldNames As Boolean
' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = True
' Replace C:\Documents\ with the real path to the folder that
' contains the EXCEL files
strPath = "C:\Users\rschuell\Desktop\test\"
' Replace tablename with the real name of the table into which
' the data are to be imported
strTable = "tablename"
strFile = Dir(strPath & "*.txt")
Do While Len(strFile) > 0
strPathFile = strPath & strFile
DoCmd.TransferText _
TransferType:=acImportDelim, _
TableName:=strTable, _
FileName:=strPathFile, _
HasFieldNames:=blnHasFieldNames
' Uncomment out the next code step if you want to delete the
' EXCEL file after it's been imported
' Kill strPathFile
strFile = Dir()
Loop
End Sub