VBA procedure to import only selected csv files (from one folder) into a single table in access
Asked Answered
R

3

2

I have a folder that contains 2000 *.csv files. But not all of them are important 4 me. Only 60 of them are important, and I have them listed, by names in access table. there is no header - only file names that need to be read into the single table database. it looks like this: enter image description here

these *.mst files are really *.csv files - it will work that way. I need a VBA procedure, that imports ONLY SELECTED files (these listed in the table) out of this folder into a single access table. yes, all these files have exactly the same structure, so they can be merged into these access table and that is the goal of this VBA procedure.

this is how every file looks like: enter image description here

the code I already got just pulls every file from this folder and imports it into the single table in access. I need it changed to pull only the selected files. destination table name is: "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 its importing the data using "Line Input" method, and I've heard, that there are some better ways to do that, but I'm no programmer myself so I'm dependent on Your help my friends. Thank U for all help and code provided :-)

screen shot 4 for A.S.H enter image description here

Rodrigo answered 17/6, 2017 at 23:42 Comment(0)
P
2

Listing the 2000+ files in the directory, checking if each is listed in the selection table, is not the right approach. It is surely preferable to read the selected files from the table and access them one by one.

The other potential speedup is using the built-in DoCmd.TransferText (as already pointed in other answers). Built-ins are usually very optimized and robust so you should prefer them unless there's a specific reason. Your own tests should confirm it.

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's 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
Pusan answered 18/6, 2017 at 3:7 Comment(6)
so is it possible to create this database I'm trying to create without using SQL inside VBA macro? _ __ _ and another question, exactly which line in Your code imports the .mst content into the access table?Rodrigo
@michalroesler yet it is possible with DoCmd.TransferText. The macro opens the files listed in the Selected_Files table and transfers them one by one (if file exists) to the Tabela1. It may need some tweaking according to your exact setup and data formats, but hopefully it will run smoothly.Pusan
The only foreseen difficulty is the date field. You may need to import it as text (set its type to text in the table design) and transform it later inside Access if needed.Pusan
DoCmd.TransferText , , "all_stocks", my_path & rs.Fields(0).Value, True this code doesn't want to run. __ __ do I need to have preformatted table created in access, before running this code? Do the table field names need to match headers in my *.CSV files?Rodrigo
After running Your code I get Run-time error '3027' "Cannot update. Database or object may be read-only". . I've checked my Trusted Locations and I guess it's all set right. I Have no other Ideas 4 now. I've read everything here access-programmers.co.uk/forums/showthread.php?t=184720 but there is nothing relevant to my situation. Please read question once more - I've added some new details in the end.Rodrigo
@michalroesler I'm afraid I can't add much; my code works perfectly for me and in my environment, (apart that the date field has to be declared as string in the destination table). You should now check what's special in yours. As a hint, check File encoding is ANSI - remove the < and > from the headers of the files, verify the field names match your table's field names. Finally, if TransferText stubbornly refuses to work, you can always revert back the body of the loop to your initial SQL code. The question was mainly on the selection of specific files and eventual speedup.Pusan
I
0

I would try using a combination of different method. I will admit I have never interacted with a .mst file in the manner youre using them but I think what IM suggesting will still work perfectly fine.

Use this to check table for file name:

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 could use DoCmd.TransferText to import the entire file into the table

Documentation of transfer text method

https://msdn.microsoft.com/VBA/Access-VBA/articles/docmd-transfertext-method-access

Idleman answered 18/6, 2017 at 2:8 Comment(0)
E
0

I use frequently Excel vba. 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
Encode answered 18/6, 2017 at 2:26 Comment(0)

© 2022 - 2024 — McMap. All rights reserved.