MS Access 需要遍历 10k csv 文件，但 MS Access 数据库填满过快

Posted 2023-04-19

【中文标题】MS Access 需要遍历 10k csv 文件，但 MS Access 数据库填满过快

【英文标题】：MS Access need to loop through 10k csv files but the MS Access database fills up too quickly

【发布时间】：2018-07-26 15:13:16

【问题描述】：

所以我有 10k 的 csv 文件需要查看。 漂亮我有一个循环遍历报告列表。它从特定文件导入 csv，然后查询导出结果返回到下一个 csv 但是，因为有 10k csv 文件数据库增长超过其最大 2GB 有没有办法刷新数据库中间循环到？像“Application.SetOption 'Auto compact', True”这样的东西。

Set rs = CurrentDb.OpenRecordset("Select * From NormalReports") 'Table of reports
If Not (rs.EOF And rs.BOF) Then 'This loop goes through each normal directory and creates the winners list for directory.
    rs.MoveFirst
    Do Until rs.EOF = True
        Directory = rs!Directory
        ReportName = rs!Name

        NUMBDATASTr = Directory & "NUMBDATM.CSV"
        NICHDATMSTr = Directory & "NICHDATM.CSV"
        PRNTDATMSTr = Directory & "PRNTDATM.CSV"

        If Directory Like "E:*" Then
            CTRY = "UK"
        ElseIf Directory Like "F:*" Then
            CTRY = "FR"
        ElseIf Directory Like "G:*" Then
            CTRY = "PW"
        ElseIf Directory Like "H:*" Then
            CTRY = "ES"
        ElseIf Directory Like "I:*" Then
            CTRY = "IT"
        ElseIf Directory Like "J:*" Then
            CTRY = "AT"
        ElseIf Directory Like "K:*" Then
            CTRY = "DE"
        ElseIf Directory Like "R:*" Then
            CTRY = "RU"
        ElseIf Directory Like "N:*" Then
            CTRY = "NO"
        ElseIf Directory Like "C:*" Then
            CTRY = "UK"
        Else
            MsgBox "Invalid directory Found"
            Exit Sub
        End If


        DoCmd.SetWarnings False
        DoCmd.OpenQuery "ResetNumbDatM"
        DoCmd.OpenQuery "ResetNICHDATM"
        DoCmd.OpenQuery "ResetPRNTDATM"
        DoCmd.SetWarnings True

        'Current Issues data types of the tables conflicting make sure to change that. Issue Noted: 06/07/2018. Resolved: NOT
        Dim CombLoop As Integer
        Dim LotusCn As Object
        Dim rsLotus As Object
        Dim strSql, CombFileName, GotoRange As String
        Dim rsLotusFiles As DAO.Recordset

        Set LotusCn = CreateObject("ADODB.Connection")
        Set rsLotus = CreateObject("ADODB.Recordset")

        DoCmd.SetWarnings False
        DoCmd.TransferText TransferType:=acImportDelim, TableName:="NUMBDATM", FileName:=NUMBDATASTr, HasFieldNames:=True
        DoCmd.DeleteObject acTable, "NUMBDATM_ImportErrors"
        DoCmd.TransferText TransferType:=acImportDelim, TableName:="PRNTDATM", FileName:=PRNTDATMSTr, HasFieldNames:=True
        DoCmd.DeleteObject acTable, "PRNTDATM_ImportErrors"
        DoCmd.TransferText TransferType:=acImportDelim, TableName:="NICHDATM", FileName:=NICHDATMSTr, HasFieldNames:=True
        DoCmd.DeleteObject acTable, "NICHDATM_ImportErrors"
        DoCmd.SetWarnings True

        'Save Path for First Export
        SaveFile = Directory & "AWD_" & MTH & ".csv"
        'End of Save Path First Export
        'Display Winners and create the table
        DoCmd.SetWarnings False
        DoCmd.OpenQuery "AWDWINNERSQRY"
        DoCmd.SetWarnings True
        'End Display

        'Export Winners to their Directory to their individual Directories
        db.TableDefs.Refresh
        DoCmd.TransferText acExportDelim, , "AWDWinners", SaveFile, True
        db.TableDefs.Refresh
        'Export to Directory Finished

        SaveFile = "Q:\CCNMACS\AWD" & CTRY & "\AWD_" & MTH & ReportName & ".csv"

        'Export Winners to their Directory to their individual Directories
        db.TableDefs.Refresh
        DoCmd.Rename "AWDWinners" & ReportName, acTable, "AWDWinners"
        DoCmd.TransferText acExportDelim, , "AWDWinners" & ReportName, SaveFile, True
        db.TableDefs.Refresh
        'Export to Directory Finished

        DoCmd.SetWarnings False
        DoCmd.DeleteObject acTable, "AWDWinners" & ReportName
        DoCmd.SetWarnings True

        Application.SetOption "Auto compact", True

        rs.MoveNext
    Loop
Else
    MsgBox "There are no Records in the RecordSet."
End If
rs.Close
Set rs = Nothing

【问题讨论】：

我会在其他任何事情发生之前将它们导入。一旦进入数据库，它们就会被处理，结果会以 csv 格式导出。我不明白您所说的手动是什么意思，这里没有什么是手动的，它选择目录本身并文件导入它。对数据运行相关的 2 个查询并将其导出回相关文件，无需任何人工干预。

MS Access: how to compact current database in VBA 可能重复 和/或 How to compact the current MS Access database from VBA function 和/或 Access “Compact and Repair” programatically

MS Access: how to compact current database in VBA的可能重复

【参考方案1】：

您无法轻松地压缩和修复处于中间过程的数据库，但是您可以轻松地对另一个数据库执行此操作。

考虑使用一个单独的“Side”数据库来保存导入的数据。你链接到那个并执行所有的导入。然后，您可以在主数据库中的循环代码中记录您到达的位置，并根据需要随时压缩和修复侧数据库。

【讨论】：

+好点子，在这种情况下，为数据建立一个单独的后端数据库有很多原因，包括能够压缩它。更多关于压缩开放数据库here的讨论。

【参考方案2】：

如前所述，可以考虑创建一个外部 accDB 文件，并将其用于处理。这样，您可以在处理“x”个文件后创建一个新的空白数据库，甚至压缩该外部 accDB。

您还应该考虑关闭行锁定，因为这可能是造成臃肿的主要原因。我看到一些进程将 6 meg 文件扩展为 126 megs，关闭行锁定导致 6 meg 文件在处理后仍然在大约 6 megs。

因此，行锁定会导致“大量”膨胀（而且您还可以获得更好的性能！！）。

因此您可以尝试关闭行锁定，但实际上，只需创建一个空白的外部 accDB 文件（并链接到该文件）也可以解决此问题。

这里是如何在您的应用程序中使用临时 mdb/accdb 的示例：

http://www.granite.ab.ca/access/temptables.htm

【参考方案3】：

如何链接文件而不是导入它们？试试TransferType:=acLinkDelim...

【讨论】：

嘿，所以在与老板讨论后，他们注意到他们实际上只需要大约 180 奇数列中的 6 列。在将其缩减为仅导入这 6 个后，我能够毫无问题地导入所有表。感谢所有帮助过的人

【参考方案4】：

如何链接到所有 10k 个文件，而不是导入它们？这将消耗更少的内存。下面的 VBA 脚本将遍历文件夹中的所有文件并链接到每个文件。

''''  LINK TO ALL CSV FILES OR ALL TEXT FILES IN A FOLDER...
Private Sub Command0_Click()

     'Macro Loops through the specified directory (strPath)
     'and links ALL Excel files as linked tables in the Access
     'Database.

    Const strPath As String = "C:\your_path_here\" 'Directory Path
    Dim strFile As String 'Filename
    Dim strFileList() As String 'File Array
    Dim intFile As Integer 'File Number

     'Loop through the folder & build file list
    strFile = Dir(strPath & "*.csv")
    While strFile <> ""
         'add files to the list
        intFile = intFile + 1
        ReDim Preserve strFileList(1 To intFile)
        strFileList(intFile) = strFile
        strFile = Dir()
    Wend
     'see if any files were found
    If intFile = 0 Then
        MsgBox "No files found"
        Exit Sub
    End If
     'cycle through the list of files & link to Access
    For intFile = 1 To UBound(strFileList)
        DoCmd.TransferText acLinkDelim, , _
        strFileList(intFile), strPath & strFileList(intFile), True, ""
         'Check out the TransferSpreadsheet options in the Access
         'Visual Basic Help file for a full description & list of
         'optional settings
    Next
    MsgBox UBound(strFileList) & " Files were Linked"

End Sub

顺便说一句，这可能会因为我喜欢提出替代解决方案而被否决，请考虑使用 R 或 Python 来操作文件。似乎导入 10k 文本文件的过程使 Access 膨胀到 2GB。这完全有道理。考虑将所有文件合并到一个文件中，然后将该文件导入 Access 中。我不知道每个文件有多大，但肯定会更容易导入一个文件而不是 10k 个文件。

# R:
setwd("C:/Users/Excel/Desktop/TEST") 
txt_files <- list.files()
list_of_reads <- lapply(txt_files, readLines)
df_of_reads <- data.frame(file_name = txt_files, contents = do.call(rbind, list_of_reads))
write.csv(df_of_reads, "one_big_CSV.csv", row.names = F)

或者……

# Python
import glob2

filenames = glob2.glob('C:/Users/Excel/Desktop/test/*.txt')  # list of all .txt files in the directory

with open('C:/Users/Excel/Desktop/test/outfile.txt', 'w') as f:
    for file in filenames:
        with open(file) as infile:
            f.write(infile.read()+'\n')

或者，最后，使用 SQL Server，并使用循环批量插入所有文件。如果您想了解有关如何执行此操作的更多信息，请回复并告诉我。