VBA procedure to import only selected csv files (from one folder) into one table in access
I have a folder containing 2000 * .csv files. But not all of them are important 4 me. Only 60 of them are important, and I list them by name in the access table. there are no header names to be read in the single table database. it looks like this:
these * .mst files are really * .csv files - it will work that way. I need a VBA routine that imports ONLY SELECTED files (listed in the table) from this folder into a single access table. yes, these files all have exactly the same structure, so they can be merged into this access table and that is the purpose of this VBA procedure.
this is how each file looks like:
the code I already got just pulls each file out of that folder and imports it into one table on access. I need to change it to only pull selected files. destination table name: "all_stocks"
Sub Importing_data_into_a_single_table()
Dim start As Double
Dim total_time As String
Dim my_path As String, my_ext As String, my_file As String
Dim FileNum As Integer
Dim DataLine As String
Dim pola() as String
Dim SQL1 As String, file_array() As String
start = Timer
my_path = "C:\Users\michal\SkyDrive\csv\bossa\mstcgl_mst\" 'Source folder.
my_ext = "*.mst" ' all files with .mst extension.
my_file = Dir(my_path & my_ext) ' take the first file from my_path.
DoCmd.SetWarnings False ' turn off warnings.
Do While my_file <> ""
FileNum = FreeFile()
Open my_path & my_file For Input As #FileNum
Line Input #FileNum, DataLine
' Reads a single line from an open sequential file and assigns it to a String variable.
While Not EOF(FileNum) ' EOF function returns a Boolean value True when the end of a file.
Line Input #FileNum, DataLine
pola = Split(DataLine, ",")
SQL1 = "INSERT INTO Tabela1 (Ticker, day, open, high, low, close, vol) VALUES('" & pola(0) & "', " & _
pola(1) & ", " & pola(2) & ", " & pola(3) & ", " & _
pola(4) & ", " & pola(5) & ", " & pola(6) & ")"
Debug.Print SQL1
DoCmd.RunSQL SQL1
Wend
Close
my_file = Dir()
Loop
DoCmd.SetWarnings True
total_time = Format((Timer - start) / 86400, "hh:mm:ss")
' total_time = Round(Timer - start, 3)
MsgBox "This code ran successfully in " & total_time & " minutes", vbInformation
End Sub
If you could optimize this code to run faster, please be my guest. Now he imported the data using the Line In method, and I heard that there are some better ways to do this, but I am not a programmer myself, so I depend on your friends for help. Thanks U for help and code :-)
source to share
Listing 2000+ files in a directory, checking if each one is listed in the pick table is the wrong approach. Of course, it is preferable to read the selected files from the table and access them one by one.
Another potential speedup is using inline DoCmd.TransferText
(as already pointed out in other answers). Built-in modules are generally very optimized and reliable, so you should prefer them unless there is a specific reason. Your own tests should confirm this.
Sub Importing_data_into_a_single_table()
Dim my_path As String, rs As Recordset, start As Double, total_time As String
my_path = "C:\Users\michal\SkyDrive\csv\bossa\mstcgl_mst\" 'Source folder.
DoCmd.SetWarnings False
start = Timer
Set rs = CurrentDb.OpenRecordset("Selected_Files")
Do Until rs.EOF
If Dir(my_path & rs.Fields(0).Value) <> "" Then
DoCmd.TransferText , , "Tabela1", my_path & rs.Fields(0).Value, True
' You could also use your code loop here; Open my_path & my_file For Input As #FileNum etc..
End If
rs.MoveNext
Loop
DoCmd.SetWarnings True
total_time = Format(Timer - start, "hh:mm:ss")
MsgBox "This code ran successfully in " & total_time, vbInformation
End Sub
source to share
I would try a combination of another method. I'll admit I've never interacted with the .mst file the way you use them, but I think the suggested IM suggestions will work just fine.
Use this to check the filename table:
Do While my_file <> "" 'some where after this line
If Isnull(Dlookup("your field name", "your table name", "Field name='" & my_file & "'") = False then
'do stuff b/c you found a match
else
'dont do stuff b/c no match
end if
Then you can use DoCmd.TransferText to import the whole file into a table
Text transmission method documentation
https://msdn.microsoft.com/VBA/Access-VBA/articles/docmd-transfertext-method-access
source to share
I use Excel vba a lot. This bellows is Excel vba method. Compare the speed of this with your method.
Sub OpenCSvs()
Dim sWs As String, Fn As String
Dim Wb As Workbook
Dim start As Double
Dim total_time As String
Dim my_path As String, my_ext As String, my_file As String
start = Timer
my_path = "C:\Users\michal\SkyDrive\csv\bossa\mstcgl_mst\" 'Source folder.
my_ext = "*.mst" ' all files with .mst extension.
my_file = Dir(my_path & my_ext) ' take the first file from my_path.
Do While my_file <> ""
Fn = my_path & my_file
Set Wb = Workbooks.Open(Fn, Format:=2)
sWs = ActiveSheet.Name
With ActiveSheet
.Rows(1).Insert
.Range("a1").Resize(1, 7) = Array("Ticker", "day", "open", "high", "low", "close", "vol")
End With
ExportToAccess Fn, sWs
Wb.Close (0)
my_file = Dir()
Loop
total_time = Format((Timer - start) / 86400, "hh:mm:ss")
MsgBox "This code ran successfully in " & total_time & " minutes", vbInformation
End Sub
Sub ExportToAccess(myFn As String, sWs As String)
Dim PathOfAccess As String
Dim strConn As String, strSQL As String
PathOfAccess = "C:\Database6.accdb" '<~~ your database path
strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & PathOfAccess & ";"
Set cn = CreateObject("ADODB.Connection")
cn.Open strConn
strSQL = "INSERT INTO Tabela1 (Ticker, day, open, high, low, close, vol) select * from [" & sWs & "$] IN '' " _
& "[Excel 8.0;HDR=yes;IMEX=2;DATABASE=" & myFn & "]"
cn.Execute strSQL
End Sub
source to share