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

问题描述

所以我有 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

标签： vbams-access

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

问题描述

解决方案

推荐阅读