VBA过程仅将选定的csv文件(从一个文件夹)导入到访问

时间:2017-06-17 23:42:23

标签: vba csv ms-access

我有一个包含2000 * .csv文件的文件夹。但并非所有这些对我而言都很重要。其中只有60个很重要,我按照访问表中的名称列出了它们。没有标题 - 只需要读入单个表数据库的文件名。 它看起来像这样: enter image description here

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

这是每个文件的样子: enter image description here

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

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

A.S.H的屏幕截图4 enter image description here

3 个答案:

答案 0 :(得分:2)

在目录中列出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

答案 1 :(得分:0)

我会尝试使用不同方法的组合。我承认我从未以你使用它们的方式与.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

答案 2 :(得分:0)

我经常使用Excel vba。这个风箱是Excel vba方法。将速度与您的方法进行比较。

(a1, b1)