Access VBA DAO | ADO Bloating Database on MakeTable Query

Question

I have a process that updates an Access Database from Oracle data three times a day to get latest information. Current production process involves:

• Create New Access Table (t1) of Most Current Data
• Move Previous Version of Data to backup version (t to t2)
• Move Current Data to Main table (t1 to t)

The reason it's done this way is in case the current data fails, users can still access earlier version of data until we can troubleshoot current data or until the next run.

There are many of the processes that we inherited and I am refactoring the process so we can trap and alert errors and stop downstream processes from running when earlier processes fail.

I've developed the following function using DAO so that I can take advantage of Execute to trap errors and bow out of the whole process gracefully. However, this process bloats the database greatly and in all my searching I cannot find a way around this. Most of the research I have done points to clearing out DAO.Recordsets and DAO.QueryDefs, neither of which I deal with in the DDL statements. I created a similar function with ADO as well, but the same issue persists.

Is there any way to clear the temp memory created in Access from this statements after executing so the code can continue without have the DB grow beyond 2GB size limit? Or perhaps it's just better to run the queries with DoCmd.RunSQL and build error trapping with GoTo. I'd like to avoid this but will settle on this if it's the only way.

Function below:

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

Here is an example of how Function is called.

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

Here is SQL for Daily Sub ALL:

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

I have encountered the same issue where my database is bloating on raw data import. VBA is not allowed to call Compact & Repair on a non-split database. Instead of splitting the database and compacting the backend routinely, I decided to use the database object (DAO) to create a temp database, import the data, query from that temp database back to original and then delete the temp database. Base code shown below:

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

Answer 2

This should probably only be a comment, but I don't have the privileges for that.

"Compact & Repair"ing a database will help with size issues. You can use the Access visual interface to do that on a regular basis or programatically: https://msdn.microsoft.com/en-us/library/office/bb220986(v=office.12).aspx

Compressing the file (only works on NTFS) will reduce the physical hard drive space occupied (as with ZIP or RAR) while improving speed with hard-drive access (fewer spins in the case of hard disks, and less bytes to read). You can even apply NTFS compression to a file on a network share.

Just today I further reduced the size of an Access database by simply copying all of the objects (it only consists of tables) to a new database file. So it became several times smaller even though I had already compacted it.

I said it's only a comment since it only helps, not solve every side of the problem in every way.

If you can, using append queries instead of make table ones might be worth trying too.

Answer 3

NOT AN ANSWER SUPPORT FOR COMMENT

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