访问 VBA DAO |关于 MakeTable 查询的 ADO 膨胀数据库

Question

我有一个流程，每天三次从 Oracle 数据更新 Access 数据库以获取最新信息。目前的生产流程包括：

• 创建最新数据的新访问表 (t1)
• 将先前版本的数据移动到备份版本（t 到 t2）
• 将当前数据移动到主表（t1 到 t）

这样做的原因是如果当前数据出现故障，用户仍然可以访问早期版本的数据，直到我们可以对当前数据进行故障排除或直到下一次运行。

我们继承了许多流程，我正在重构流程，以便我们可以捕获和警告错误，并在早期流程失败时停止下游流程的运行。

我使用 DAO 开发了以下功能，以便我可以利用Execute 捕获错误并优雅地退出整个过程。然而，这个过程极大地膨胀了数据库，在我的所有搜索中，我找不到解决这个问题的方法。我所做的大部分研究都指向清除DAO.Recordsets 和DAO.QueryDefs，我在DDL 语句中都没有处理。我也用 ADO 创建了一个类似的函数，但同样的问题仍然存在。

有什么方法可以在执行后从该语句中清除在 Access 中创建的临时内存，这样代码就可以继续，而数据库不会超过 2GB 大小限制？或者，使用DoCmd.RunSQL 运行查询并使用GoTo 构建错误捕获可能会更好。我想避免这种情况，但如果这是唯一的方法，我会解决这个问题。

函数如下：

Function ExecuteSQL(db As DAO.Database, sQuery As String) As Boolean

'*******************************************************************
'**    Sub:     ExecuteSQL
'**    Purpose: Stores current copy of Daily Eff Date table from Daily Eff Table1 and backs up previous version in Daily Eff Date2
'**    Notes:   Requires reference to Microsoft DAO 3.6 Object Library (or equivalent)
'*******************************************************************

Dim wSpace As DAO.Workspace
Set wSpace = DBEngine.Workspaces(0)

On Error GoTo ErrHandler

With wSpace

    .BeginTrans

    db.Execute sQuery, dbFailOnError

    .CommitTrans

    ExecuteSQL = True

End With

LeaveExecuteSQL:

    wSpace.Close
    Exit Function

ErrHandler:

    wSpace.Rollback
    Resume LeaveExecuteSQL

End Function

这里是一个如何调用 Function 的示例。

If Not ExecuteSQL(CurrentDb, "Daily Sub ALL") Then 'Bring Submission Data into Access

    strSubject = "ERROR in Creating The Daily Effective Date Table"
    GoTo LeaveRunProcess

End If

这是Daily Sub ALL 的 SQL：

SELECT PRODCT_EFF_DT, Left([DWCFEUL5_DEV_SUB_RPT_STATUS_SUBM_ALL_NM]![PRODUCT_SIC_CD],4) AS Expr1, Left([PRODUCT_SIC_CD],4) AS [SIC Short], INS_RQMT_PRODCT_NO, CMPNY_REGN_NM, PROCESSING_REGION, PROCESSING_RGN_NM, CMPNY_CD, CMPNY_NM, PUC_NAME, UW_REGION_NAME, PUC_NO, CLIENT_NAME, CLIENT_NUMBER, ACCOUNT_NUMBER, DUNS_NUMBER, DUNS_PARENT, PRODUCER_NUMBER, PRODUCER_NAME, PRODUCER_CONTACT, PRODCR_CNTCT_PRSN_NO, PRODUCT_TYPE, BRANCH_TYPE, BRANCH_NAME, DEPT_NO, NEW_DEPT_NO, DEPT_CD, DEPT_NM, NEW_DEPT_NM, NEW_PRFT_CENTR_NO, PROFT_CNTR_NM, NEW_PRFT_CENTR_NM, EXP_POLICY_NO, EXPPOLICYNO10, POLICY_NO, POLICYNO10, PRODCT_ATCHMT_PNT_AMT, DED_AMT, LMT_AMT, PRODCT_EXP_DT, QUOTE_BY_DT, PRODCT_DESIRBLTY, NEW_PRODCR_NM, PRODCT_SUCCESS_CHNC, WIN_CARR_NAME, INCUMBENT_INS_CARR, PRODCT_EFF_MONTH, LINE_OF_BUSINESS, PRODCT_NO, PROFIT_CENTER, EXP_PREMIUM, UNDERWRITER_NAME, EMPL_ID, STATE, LAST_UPDT_TS, PREM_AMT, DT_RECEIVED, DT_RESERVED, DT_ASSIGNED, DT_WORKING, DT_QUOTED, DT_BOUND, DT_ISSUED, DT_BOOKED, DT_MAILED, DT_DECLINED, DT_QUOTE_NOT_WRITTEN, CURR_STATUS, CURR_STATUS_CD, CURR_STATUS_CHG_USR, CURR_STATUS_EFF_DT, UW_ASISTANT_NAME, COMPANY_TYPE, CREATE_DT, CREATE_USR, PRM_FINCG_IND, BNKRPCY_STAT_CD, BRKR_MNSCRPT_FORMS_IND, UNDLYG_CNF_WRITN_IND, PRODUCT_SIC_CD, ACCT_SIC, ACCT_SIC_DESC, ACCT_SIC_PCT, PROG_TYP_CD, EXT_REPT_IND, MOT_TRK_LIAB_FIL, MOT_TRK_CRG_FIL, SUBJ_TO_AUDIT, COMP_RATED_IND, CONSENT_TO_RATE, IND_RISK_RATING, NY_FREE_TRD_ZONE, EPOL_DELIVERED, PAYDEX_SCORE, CREDIT_SCORE, FINANCIAL_STRESS_SCORE, YEARS_IN_BUSINESS, DNB_NO, DNB_NAME, DNB_PARENT_NO, DNB_HEADQUARTERS_NO, DNB_ADDRESS_LINE1, DNB_ADDRESS_LINE2, DNB_ZIPCODE, DNB_CITY, DNB_STATE, DNB_COUNTRY_CODE, COMMERCIAL_CREDIT_SCORE, START_YEAR, CURRENT_CONTROL_YEAR, NAICS_CODE, INSRD_NM, PRODCR_LONG_NAME, SIR_AMOUNT, EMAIL_ADDRS_TXT, SUB_PRODUCER_NO, SUB_PRODUCER_CODE, SUB_PRODUCER_NM, SUB_PRODUCER_ADDRESS_LINE1, SUB_PRODUCER_ADDRESS_LINE2, SUB_PRODUCER_ADDRESS_LINE3, SUB_PRODUCER_CITY, SUB_PRODUCER_STATE, SUB_PRODUCER_ZIPCODE, PRODUCER_PHONE_NO, SHOPPING, ASSOC_NO, VIABILITY_SCORE, POLICY_ISSUED_BY, ASSOCIATE_UW, FEIN_N0, PRODUCER_FEIN 
INTO [Daily Eff Date1]
FROM DWCFEUL5_DEV_SUB_RPT_STATUS_SUBM_ALL_NM
WHERE (((PRODCT_EFF_DT)>#1/1/2015#) AND ((NEW_PRFT_CENTR_NM) Not Like "Hawaii"));

Answer 1

不支持评论

Option Compare Database

Private WithEvents conCUSTOM_CONNECTION As ADODB.CONNECTION

Public Event evtEXECUTEERROR(ByVal pError As ADODB.Error)
Public Event evtEXECUTESUCCESS()

Public Sub INITIALISE_CONNECTION(con As ADODB.CONNECTION)
    Set conCUSTOM_CONNECTION = con
End Sub

Private Sub conCUSTOM_CONNECTION_ExecuteComplete(ByVal RecordsAffected As Long, _
                    ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, _
                    ByVal pCommand As ADODB.Command, ByVal pRecordset As ADODB.Recordset, _
                    ByVal pConnection As ADODB.CONNECTION)
    If pError Is Nothing Then
        RaiseEvent evtEXECUTESUCCESS
    Else
        RaiseEvent evtEXECUTEERROR(pError)
    End If
End Sub

Answer 2

这应该只是一个评论，但我没有权限。

“压缩和修复”数据库将有助于解决大小问题。您可以使用 Access 可视化界面定期或以编程方式执行此操作： https://msdn.microsoft.com/en-us/library/office/bb220986(v=office.12).aspx

压缩文件（仅适用于 NTFS）将减少占用的物理硬盘空间（如 ZIP 或 RAR），同时提高硬盘访问速度（在硬盘的情况下旋转更少，读取的字节更少）。您甚至可以对网络共享上的文件应用 NTFS 压缩。

就在今天，我通过简单地将所有对象（它仅由表组成）复制到一个新的数据库文件来进一步减小了 Access 数据库的大小。所以即使我已经压缩了它，它也变得小了好几倍。

我说这只是一个评论，因为它只提供帮助，而不是从各个方面解决问题的各个方面。

如果可以的话，使用追加查询而不是创建表查询可能也值得一试。

Answer 3

我遇到了相同的问题，即我的数据库在导入原始数据时膨胀。不允许 VBA 在非拆分数据库上调用压缩和修复。我决定使用数据库对象 (DAO) 创建一个临时数据库，导入数据，从该临时数据库查询回原始数据库，然后删除该临时数据库，而不是常规拆分数据库和压缩后端。基本代码如下：

Sub tempAccessDatabaseImport()
    Dim mySQL As String
    Dim tempDBPath As String
    Dim myWrk As DAO.Workspace
    Dim tempDB As DAO.Database
    Dim myObject

    'Define temp access database path
    tempPathArr = Split(Application.CurrentProject.Path, "\")
    For i = LBound(tempPathArr) To UBound(tempPathArr)
        tempDBPath = tempDBPath + tempPathArr(i) + "\"
    Next i
    tempDBPath = tempDBPath + "tempDB.accdb"

    'Delete temp access database if exists
    Set myObject = CreateObject("Scripting.FileSystemObject")
    If myObject.FileExists(tempDBPath) Then
        myObject.deleteFile (tempDBPath)
    End If

    'Open default workspace
    Set myWrk = DBEngine.Workspaces(0)

    'DAO Create database
    Set tempDB = myWrk.CreateDatabase(tempDBPath, dbLangGeneral)

    'DAO - Import temp xlsx into temp Access table
    mySQL = "SELECT * INTO tempTable FROM (SELECT vXLSX.*FROM [Excel 12.0;HDR=YES;DATABASE=" & RAWDATAPATH & "].[" & WORKSHEETNAME & "$] As vXLSX)"

    'DAO Execute SQL
    Debug.Print mySQL
    Debug.Print
    tempDB.Execute mySQL, dbSeeChanges

    'Do Something Else

    'Close DAO Database object
    tempDB.Close
    Set tempDB = Nothing

    myWrk.Close
    Set myWrk = Nothing

    'Delete temp access database if exists
    If myObject.FileExists(tempDBPath) Then
        'myObject.deleteFile (tempDBPath)
    End If
End Sub