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

Posted 2023-05-07

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

【英文标题】：VBA procedure to import only selected csv files (from one folder) into a single table in access

【发布时间】：2017-06-17 23:42:22

【问题描述】：

我有一个包含 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

【参考方案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

【讨论】：

那么是否可以在不使用 VBA 宏中的 SQL 的情况下创建我正在尝试创建的数据库？ _ __ _ 和另一个问题，您的代码中究竟是哪一行将 .mst 内容导入到访问表中？

@michalroesler 但DoCmd.TransferText 是可能的。该宏打开Selected_Files 表中列出的文件，并将它们一一传输（如果文件存在）到Tabela1。它可能需要根据您的确切设置和数据格式进行一些调整，但希望它能够顺利运行。

唯一可预见的困难是日期字段。您可能需要将其作为文本导入（在表格设计中将其类型设置为文本）并稍后在 Access 中根据需要对其进行转换。

DoCmd.TransferText , , "all_stocks", my_path & rs.Fields(0).Value, True 此代码不想运行。 __ __ 在运行此代码之前，我是否需要在 access 中创建预格式化的表？表字段名称是否需要与我的 *.CSV 文件中的标题匹配？

运行您的代码后，我收到运行时错误“3027”“无法更新。数据库或对象可能是只读的”。 .我检查了我的受信任位置，我想一切都设置正确。我现在没有其他想法 4。我已经阅读了access-programmers.co.uk/forums/showthread.php?t=184720 的所有内容，但与我的情况无关。请再次阅读问题 - 我最后添加了一些新的细节。

【参考方案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

【参考方案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