VBA 程序仅将选定的 csv 文件（从一个文件夹）导入到访问中的单个表中

Question

我有一个包含 2000 个 *.csv 文件的文件夹。但并非所有这些都是重要的 4 我。其中只有 60 个是重要的，我在访问表中按名称列出了它们。没有标题 - 只有需要读入单表数据库的文件名。 它看起来像这样：

这些 *.mst 文件实际上是 *.csv 文件 - 它会以这种方式工作。 我需要一个 VBA 过程，它只将选定的文件（表中列出的这些文件）从此文件夹中导入到单个访问表中。 是的，所有这些文件都具有完全相同的结构，因此它们可以合并到这些访问表中，这就是这个 VBA 过程的目标。

这是每个文件的样子：

我已经获得的代码只是从该文件夹中提取每个文件并将其导入到访问中的单个表中。 我需要将其更改为仅提取选定的文件。 目标表名是：“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

如果您可以优化此代码以更快地运行，请成为我的客人。 现在它使用“Line Input”方法导入数据，我听说有一些更好的方法可以做到这一点，但我自己不是程序员，所以我依赖于你的帮助我的朋友们。 感谢您提供的所有帮助和代码:-)

A.S.H 的屏幕截图 4

Answer 1

列出目录中的 2000 多个文件，检查每个文件是否都列在选择表中，这不是正确的方法。最好从表中读取选定的文件并逐个访问它们。

另一个潜在的加速是使用内置的DoCmd.TransferText（正如其他答案中已经指出的那样）。内置插件通常非常优化和健壮，因此除非有特定原因，否则您应该更喜欢它们。您自己的测试应该可以确认。

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

Answer 2

我会尝试使用不同方法的组合。我承认我从未以您使用它们的方式与 .mst 文件进行过交互，但我认为 IM 建议的内容仍然可以正常工作。

使用它来检查表中的文件名：

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

然后您可以使用 DoCmd.TransferText 将整个文件导入表中

传输文本方法的文档

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

Answer 3

我经常使用 Excel vba。这波纹管是Excel vba方法。将此速度与您的方法进行比较。

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