FE Database Still Experiencing Bloat (1 Viewer)

[AngelSpeaks]

I posted on another thread about my FE having database bloat and I've implemented the following changes:

1) removed to temporary tables, so I'm no longer making tables, deleting all records, and appending to it.
2) added a routine to close all forms and reports when frmNavigation is closed
3) added docmd.close to reports that seem to be behind the bloat
4) added close to Excel automation
5) Outlook automation set to nothing (close causes error message.
6). added close to dao objects.

The bloat seems to be centered on two activities. The one where I'm creating .csv files, calling Excel automation to open and save, and outputting a report to pdf for each unique job. The second, a new activity, creates a report for a selected job, sends it to pdf, and then invokes Outlook to send an email.

The code for activity 1

Private Sub cmdExport_Click()
        
    Dim dbs As dao.Database
    Dim qdf As dao.QueryDef
    Dim rst As dao.Recordset
    Dim lRecCount             As Long
    Set dbs = CurrentDb
    
    Set qdf = dbs.QueryDefs("qryMissingEmployees")
 
    'Open a Recordset based on the parameter query
    Set rst = qdf.OpenRecordset()
    lRecCount = rst.RecordCount
    If lRecCount > 0 Then
        msgText = "Employees are Missing - Procedure Stopped"
        Response = MsgBox(msgText, vbOKOnly, msgApp)
        Exit Sub
    End If
    rst.Close
    Set rst = Nothing
    
    Set qdf = dbs.QueryDefs("qryMissingJobs")
 
    Set rst = qdf.OpenRecordset()
    lRecCount = rst.RecordCount
    If lRecCount > 0 Then
        msgText = "Jobs are Missing - Procedure Stopped"
        Response = MsgBox(msgText, vbOKOnly, msgApp)
        Exit Sub
    End If
    rst.Close
    Set rst = Nothing
    
    Set qdf = dbs.QueryDefs("qryMissingPublicBody")
 
    Set rst = qdf.OpenRecordset()
    lRecCount = rst.RecordCount
    If lRecCount > 0 Then
        msgText = "Public Body records are Missing - Procedure Stopped"
        Response = MsgBox(msgText, vbOKOnly, msgApp)
        Exit Sub
    End If
    rst.Close
    dbs.Close          '3-2-22
    
    Set rst = Nothing
    TempVars.RemoveAll
    dteStart = Me.StartDate
    dteEnd = Me.EndDate
    TempVars.Add "StartDate", dteStart
    TempVars.Add "EndDate", dteEnd
    TempVars.Add "State", gstrState
    
    Dim strCriteria As String                  'Date criteria to extract unique jobs
  
    
    Select Case gstrState
        Case "IL"
            Illinois_Split
    End Select
End Sub


Private Sub Illinois_Split()
    Dim sDate As String
    Dim lRecCount As Integer
    
    'For renaming columns
    Dim sFile As String
    Dim sFieldNamesOrig As String, sFieldNamesTarget As String

    Dim oApp As Excel.Application      'Excel Application
    'dim oApp as Object    'you can remove the reference to Microsoft Excel xx.0 Object library)
    Set oApp = CreateObject("Excel.Application")     'opens new instance of Excel
    oApp.Visible = False            'for testing, you can see what Excel does, set to false when done
    'Dim oWkbk As Object      'defines a workbook
    Dim oWkbk As Excel.Workbook
    oApp.DisplayAlerts = False            'turn off alerts
  
    msgApp = "Certified Payroll"
    
    'Extract Unique Jobs
    strCriteria = "[Date] Between " & Format(dteStart, strcJetDate) & " And " & Format(dteEnd, strcJetDate)  ' Setup Date Criteria
    Set rsJobs = CurrentDb.OpenRecordset("SELECT DISTINCTROW Job FROM tblPWBenefits WHERE (" & strCriteria & ") GROUP BY Job ORDER BY Job;", dbOpenDynaset)
    
    lRecCount = rsJobs.RecordCount
    If lRecCount = 0 Then
        msgApp = "Certified Payroll"
        msgText = "No Jobs within that date period - Procedure Stopped"
        Response = MsgBox(msgText, vbOKOnly, msgApp)
        Exit Sub
    End If
    
    Dim FileName As String
    Dim filenamePDF As String
    Dim directoryName As String
    
    sDate = Format(dteStart, "mmddyyyy")
    dashdate = Format(dteStart, "mm-dd-yyyy")
    directoryName = gExportPath & "\" & dashdate
    
    'Make directory
    If Not DirExists(directoryName) Then
        MkDir (directoryName)
    End If

    TempVars.Add "StartDate", dteStart
    TempVars.Add "EndDate", dteEnd
    
    Dim dbs As dao.Database
    Dim qdf As dao.QueryDef
    Dim rst As dao.Recordset

    Set dbs = CurrentDb
        
    Do While Not rsJobs.EOF
        Job = rsJobs!Job
        
        'Set up from/to for Job Selection
        TempVars.Add "Job", Job                       'for qryIllinoisPWExportPortal
        TempVars.Add "JobTo", Job                    'Not being used, I don't think
        
        TempVars.Add "JobStart", Job                  'for qryIllinoisPWExport
        TempVars.Add "JobEnd", Job
        
        FileName = directoryName & "\State " & gstrState & " Job " & Job & " Start Date " & sDate & " - CP Upload.csv"
        
        DoCmd.TransferText acExportDelim, "qryIllinoisPWExport Export Specification", "qryIllinoisPWExport", FileName, True

         'Rename Columns
        sFieldNamesOrig = Me.FieldNamesOriginal
        sFieldNamesTarget = Me.FieldNamesTarget
        sFile = FileName
        
        'Below is code to do what TransferText does
        'Set rs = CurrentDb.OpenRecordset(rsExportSQL, dbOpenDynaset)
        'Call ExportToCSV(rs, sFile, True)
        
        'replace original with target
        Call TextFile_FindReplace(sFile, sFieldNamesOrig, sFieldNamesTarget)
        
        'Use Excel to save file in format IDOL Portal wants
        With DoCmd
            .SetWarnings False
             Set oWkbk = oApp.WorkBooks.Open(sFile)
             oWkbk.SaveAs sFile
             oWkbk.Close
             .SetWarnings True
        End With
              
        filenamePDF = directoryName & "\State " & gstrState & " Job " & Job & " Start Date " & sDate & " - CP Upload.pdf"

        With DoCmd
            .SetWarnings False
            .OutputTo acOutputReport, "rptAffidavit", acFormatPDF, filenamePDF
            .SetWarnings True
        End With
        DoCmd.Close acOutputReport, "rptAffidavit"             '3-2-22
        rsJobs.MoveNext
    Loop
    Set qdf = Nothing
    Set dbs = Nothing
   ' dbs.Close              '3-2-22   error message
  '  rst.Close              '3-2-22   error message
    rsJobs.Close           '3-2-22
    
     'Close Excel
    Set oWkbk = Nothing
    oApp.DisplayAlerts = True
    Set oApp = Nothing
    oWkbk.Close            '3-2-22
    oApp.Close              '3-2-22
    
    msgText = "Extract Completed, look at folder " & gExportPath & " for extracted CSV files"
    Response = MsgBox(msgText, vbOKOnly, msgApp)
End Sub

The code for activity 2, create pdf:

Private Sub cmdReportPDF_Click()
     'Check to make sure job was selected
     If IsNull(Me.cboJob.Value) Then
        msgApp = "Certified Payroll Reporting"
        msgText = "Please select a Job from the list"
        Response = MsgBox(msgText, vbOKOnly, msgApp)
        Exit Sub
    End If
    
    'set default path
    If Len(gExportPath) = 0 Then
        gExportPath = CurrentProject.Path
    End If
    
    Dim directoryName As String
    
    Dim blnNoWork As Boolean
    blnNoWork = False
    
    dteStart = Me.StartDate
    dteEnd = Me.EndDate
    intJob = CLng(Me.cboJob)

    sDate = Format(dteStart, "mmddyyyy")
    dashdate = Format(dteStart, "mm-dd-yyyy")
    directoryName = gExportPath & "\CPReports"
    
    'Make directory
    If Not DirExists(directoryName) Then
        MkDir (directoryName)
    End If

    
    TempVars.RemoveAll
    
    TempVars.Add "StartDate", dteStart
    TempVars.Add "EndDate", dteEnd
    TempVars.Add "JobStart", intJob
    TempVars.Add "JobEnd", intJob
    TempVars.Add "State", gstrState
    TempVars.Add "NoWork", blnNoWork
 
    filenamePDF = directoryName & "\CPReport for Job " & intJob & " Start Date " & dashdate & ".pdf"

    With DoCmd
        .SetWarnings False
        .OutputTo acOutputReport, "rptCPReport", acFormatPDF, filenamePDF
        .SetWarnings True
    End With
    DoCmd.Close acOutputReport, "rptCPReport"             '3-2-22
    
    msgApp = "Certified Payroll"
    msgText = "CP Report created " & filenamePDF
    Response = MsgBox(msgText, vbOKOnly, msgApp)
    
    cmdEmail.Visible = True
End Sub

Form has a button to send an email, which has a button to launch Outlook:

Private Sub cmdEmail_Click()
    ' Define app variable and get Outlook using the "New" keyword
    Dim OutApp As Object
    Dim OutMail As Object  ' An Outlook Mail item
    
    ' Create a new email object
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)

    Dim strTo As String
    Dim strCc As String
    Dim strBcc As String
    Dim strMessage As String
    Dim strSubject As String
    Dim strAttch As String

    strTo = Me.txtEmail
    strAttch = Me.txtAttachment
    strSubject = Me.txtSubject
    strMessage = Me.txtMessage
    If Not IsNull(Me.SecondaryEmail) Then
        strCc = Me.SecondaryEmail
    End If
    ' Add the To/Subject/Body to the message and display the message
    With OutMail
        .To = strTo
        .Cc = strCc
        .Bcc = strBcc
        .Attachments.Add strAttch
        .Subject = strSubject
        .Body = strMessage
        .display       ' Display the message
    End With

    ' Release all object variables
    Set OutApp = Nothing
    Set OutMail = Nothing
   ' OutApp.Close                 '3-2-22
   ' OutMail.Close                '3-2-22

End Sub

Thanks for any help you can provide.

 

[AngelSpeaks]

First post was too long.

frmNavigation OnClose event has:

Private Sub Form_Close()
     'Turn on TooBar
    DoCmd.ShowToolbar "Ribbon", acToolbarYes
    
    'Close all open forms and reports
    CloseAllOpenForms
    CloseReports
    
End Sub
Public Sub CloseAllOpenForms(Optional sExceptFormName$ = "")
'Closing of all open forms except the one specified in the argument: sExceptFormName
'Code provided by user Eugene-LS on Access World Forum
'----------------------------------------------------------------------------------------------
Dim iVal%, iValX%, sVal$
Dim frm As Form
'----------------------------------------------------------------------------------------------
On Error GoTo CloseAllOpenForms_Err
    iValX = Forms.Count
    For iVal = 0 To iValX - 1
        Set frm = Forms(iVal)
        sVal = frm.Name
        'Debug.Print sVal
        If sVal <> sExceptFormName Then
            'If the form is in the add mode - Undo!
            If frm.NewRecord = True Then
                frm.Undo
            End If
            DoCmd.Close acForm, sVal, acSaveYes
        End If
    Next

CloseAllOpenForms_End:
    On Error Resume Next
    Set frm = Nothing
    Err.Clear
    Exit Sub

CloseAllOpenForms_Err:
    'MsgBox "Error: " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "in Sub: CloseAllOpenForms", vbCritical, "Error in Application"
    Err.Clear
    Resume CloseAllOpenForms_End
End Sub

Public Function CloseReports()
'Close all open reports
    On Error GoTo errHandler
    Do While Reports.Count > 0
        DoCmd.Close acReport, Reports(0).Name
    Loop
    Exit Function
errHandler:
    MsgBox Err.Number & ": " & Err.Description, vbOKOnly, "Error"
End Function

 

[Cronk]

I've always set opened objects to nothing in every procedure. You do that in your code but not consistently eg rstJobs in Sub Illinois_Split()

I have all my Dim statements at the start of procedures and set all objects to nothing at the end. Makes it easier not to miss anything.

Can't say this will eliminate your bloat.

 

[AngelSpeaks]

Thanks Cronk.

 

[CJ_London]

Have to say I don't see anything in your code that is likely to cause your FE to bloat

but three suggestions

1. step through your code and keep an eye on the FE size to try to identify which line(s) causes the size to increase
2. decompile your code before compact/repairing, then recompile
3. compile your code and create a .accde for the FE

 

[AngelSpeaks]

Have to say I don't see anything in your code that is likely to cause your FE to bloat

but three suggestions

1. step through your code and keep an eye on the FE size to try to identify which line(s) causes the size to increase
2. decompile your code before compact/repairing, then recompile
3. compile your code and create a .accde for the

Have to say I don't see anything in your code that is likely to cause your FE to bloat

but three suggestions

1. step through your code and keep an eye on the FE size to try to identify which line(s) causes the size to increase
2. decompile your code before compact/repairing, then recompile
3. compile your code and create a .accde for the FE

1. Great suggestion!

2. How do you decompile?
3.I tried creating an .accde but it said the database was too big.

 

[AccessBlaster]

How many objects are in the FE?
What is the current size of the FE?

 

[AngelSpeaks]

How many objects are in the FE?
What is the current size of the FE?

I'm not home right now, i'll get back

 

[bastanu]

Hi Cathy,
I had a quick look at the first one and made some changes to the first sub; with your existing code you are exiting the sub leaving some of the objects open:

Private Sub cmdExport_Click()
        
    Dim dbs As dao.Database
    Dim qdf As dao.QueryDef
    Dim rst As dao.Recordset
    Dim lRecCount             As Long
    'Set dbs = CurrentDb
    
    'Set qdf = dbs.QueryDefs("qryMissingEmployees")
 
    ''Open a Recordset based on the parameter query
    'Set rst = qdf.OpenRecordset()
    'lRecCount = rst.RecordCount
    'If lRecCount > 0 Then
    If dCount("*","qryMissingEmployees")>0
        msgText = "Employees are Missing - Procedure Stopped"
        Response = MsgBox(msgText, vbOKOnly, msgApp)
        Exit Sub
    End If
    'rst.Close
    'Set rst = Nothing
    
    'Set qdf = dbs.QueryDefs("qryMissingJobs")
 
    'Set rst = qdf.OpenRecordset()
    l'RecCount = rst.RecordCount
    'If lRecCount > 0 Then
    If dCount("*","qryMissingJobs")>0
        msgText = "Jobs are Missing - Procedure Stopped"
        Response = MsgBox(msgText, vbOKOnly, msgApp)
        Exit Sub
    End If
    'rst.Close
    'Set rst = Nothing
    
    'Set qdf = dbs.QueryDefs("qryMissingPublicBody")
 
    'Set rst = qdf.OpenRecordset()
    'lRecCount = rst.RecordCount
    'If lRecCount > 0 Then
    If dCount("*","qryMissingPublicBody")>0
        msgText = "Public Body records are Missing - Procedure Stopped"
        Response = MsgBox(msgText, vbOKOnly, msgApp)
        Exit Sub
    End If
    'rst.Close
    'dbs.Close          '3-2-22
    
    'Set rst = Nothing
    'TempVars.RemoveAll
    dteStart = Me.StartDate
    dteEnd = Me.EndDate
    
    If IsNull(TempVars("StartDate") = "") Then
        TempVars.Add "StartDate", dteStart
    Else
        TempVars!StartDate = dteStart
    End If
    
    If IsNull(TempVars("EndDate") = "") Then
        TempVars.Add "EndDate", dteEnd
    Else
        TempVars!EndDate = dteEnd
    End If
    
    If IsNull(TempVars("State") = "") Then
        TempVars.Add "State", gstrState
    Else
        TempVars!State = gstrState
    End If
            
    Dim strCriteria As String                  'Date criteria to extract unique jobs
     
    Select Case gstrState
        Case "IL"
            Illinois_Split
    End Select
End Sub

In the second one I notice you are make a lot of use of tempvars, I do not usually use them and I am not sure if the TempVar.Add "State", gstrState would work as you intend in a loop; I would think it would error out if the tempvar is already created so you would need to use TempVars!State=gstrState.

Usually constantly creating and deleting objects is the main cause of Access bloat, so maybe try to create a form to hold all those values instead of using tempvars.

Cheers,

 

[AngelSpeaks]

How many objects are in the FE?
What is the current size of the FE?

Current size is 155,520kb
15 tables
42 queries
31 forms
22 reports
4 modules

 

[AngelSpeaks]

Hi Cathy,
I had a quick look at the first one and made some changes to the first sub; with your existing code you are exiting the sub leaving some of the objects open:

Private Sub cmdExport_Click()
       
    Dim dbs As dao.Database
    Dim qdf As dao.QueryDef
    Dim rst As dao.Recordset
    Dim lRecCount             As Long
    'Set dbs = CurrentDb
   
    'Set qdf = dbs.QueryDefs("qryMissingEmployees")

    ''Open a Recordset based on the parameter query
    'Set rst = qdf.OpenRecordset()
    'lRecCount = rst.RecordCount
    'If lRecCount > 0 Then
    If dCount("*","qryMissingEmployees")>0
        msgText = "Employees are Missing - Procedure Stopped"
        Response = MsgBox(msgText, vbOKOnly, msgApp)
        Exit Sub
    End If
    'rst.Close
    'Set rst = Nothing
   
    'Set qdf = dbs.QueryDefs("qryMissingJobs")

    'Set rst = qdf.OpenRecordset()
    l'RecCount = rst.RecordCount
    'If lRecCount > 0 Then
    If dCount("*","qryMissingJobs")>0
        msgText = "Jobs are Missing - Procedure Stopped"
        Response = MsgBox(msgText, vbOKOnly, msgApp)
        Exit Sub
    End If
    'rst.Close
    'Set rst = Nothing
   
    'Set qdf = dbs.QueryDefs("qryMissingPublicBody")

    'Set rst = qdf.OpenRecordset()
    'lRecCount = rst.RecordCount
    'If lRecCount > 0 Then
    If dCount("*","qryMissingPublicBody")>0
        msgText = "Public Body records are Missing - Procedure Stopped"
        Response = MsgBox(msgText, vbOKOnly, msgApp)
        Exit Sub
    End If
    'rst.Close
    'dbs.Close          '3-2-22
   
    'Set rst = Nothing
    'TempVars.RemoveAll
    dteStart = Me.StartDate
    dteEnd = Me.EndDate
   
    If IsNull(TempVars("StartDate") = "") Then
        TempVars.Add "StartDate", dteStart
    Else
        TempVars!StartDate = dteStart
    End If
   
    If IsNull(TempVars("EndDate") = "") Then
        TempVars.Add "EndDate", dteEnd
    Else
        TempVars!EndDate = dteEnd
    End If
   
    If IsNull(TempVars("State") = "") Then
        TempVars.Add "State", gstrState
    Else
        TempVars!State = gstrState
    End If
           
    Dim strCriteria As String                  'Date criteria to extract unique jobs
    
    Select Case gstrState
        Case "IL"
            Illinois_Split
    End Select
End Sub

In the second one I notice you are make a lot of use of tempvars, I do not usually use them and I am not sure if the TempVar.Add "State", gstrState would work as you intend in a loop; I would think it would error out if the tempvar is already created so you would need to use TempVars!State=gstrState.

Usually constantly creating and deleting objects is the main cause of Access bloat, so maybe try to create a form to hold all those values instead of using tempvars.

Cheers,

Thanks Vlad. I really appreciate this!

 

[AngelSpeaks]

Vlad, the tempvars are used in the queries for selection criteria.

 

[AngelSpeaks]

Current size is 155,520kb
15 tables
42 queries
31 forms
22 reports
4 modules

Now the size is 161,696 and I all did was run reports!

 

[AngelSpeaks]

I did find the steps to decompile and tried them and the database only got down to 156228 kb.

When doing the alt f11 to open the VBE to perform the Debug/Compile, is it common that it just selects any module? It grabbed to OnActivate event for my newest report.

Also, my Options for the Current Database has frmLink as the Display Form. frmLink is the procedure to relink the tables if that had anything to do with it.

 

[The_Doc_Man]

Here is a sad but true fact. Queries (either defined as QueryDefs or defined as a dynamic SQL string) lead to bloat. Even the queries that are part of the .Recordsource for forms and reports. Some queries are more likely to create a lot of bloat, others less - but it is inevitable. The mechanism is that Access must evaluate your query to create a list of elements that will be in the .Recordset resulting from opening that query, form, or report. The only Access database that won't bloat is one that is never opened.

This list, like everything else in any program that generates lists, occupies memory. These temporary lists might be small. They might be large. Depends on the query. Oh, don't worry about the lists sitting there. It is not that the temp tables and working space lists aren't marked as "no longer in use." It is that they are allocated in non-uniform sizes, exactly the size needed for the record in question Because of the way string fields are stored (using a static string descriptor), records containing strings might vary in length from one record to the next on the same TableDef. Different tables and queries produce different sized records. And where Access builds its "query membership" list is in the only place it has... its own address space, which implies allocation of working memory. Which is actually where your tables, forms, reports etc. ALSO reside.

So, you say, why not reclaim the temporary space? This is when bloat occurs. There has been this problem called "garbage collection" that has plagued systems for years. There is no known algorithm to reliably re-thread the discarded space back to form a larger free chunk of memory unless you always release the memory in the reverse order that you allocated it. Remember that tables are stored in no particular order. Well, that is the problem. The records in that list might be allocated in no particular order either. (I.e. could be unpredictable.) So there is no way short of the Compact & Repair operation to reclaim that discarded memory. There are ways around it, and in a large-memory-model system (64-bit address space), these ways are decent - but in a smaller machine, they are terribly wasteful. Access was originally created in a time when the biggest memory space available was 4 GB for an entire system.

For those who are morbidly curious, the way to minimize bloat in general programming is to pre-organize memory into fixed-size buffers and create lists of buffers. Then, you pick the smallest buffer that is bigger than the amount of memory you want. When you are done, you release the buffer. But this method, sometimes called "look-aside lists", can terribly waste memory space. And Access was developed at a time when this method wasn't practical.

 

[bastanu]

Vlad, the tempvars are used in the queries for selection criteria.

I know Cathy, but we've been running queries and reports long before the tempvars Again, I have not used them in such an extensive way as you are in here, but it looks like a good place to start. For example in your cmdReportPDF_Click procedure why can't the report's (rptCPReport) recordsource reference the form controls directly instead of removing all tempvars and recreating them.

But I thing the biggest impact is in the Illinois_Split procedure where you are adding tempvars for each record while looping through rsJobs recordset (and I don't see any RemoveAll).

Cheers,

 

[arnelgp]

1) removed to temporary tables, so I'm no longer making tables, deleting all records, and appending to it.

whether you saved the temp table to another db, access still uses hidden system tables to track things, like table names, fields, indexes, etc.
it is constantly creating it's own "records" on the background.
if for the first time, you created a table, it's definition (details and structures) are "written" in system table/s.
it is transparent to us and only msa knows when to these records are being deleted and reclaimed (we don't know).
that is why there is Always a bloat (and is un avoidable).

 

[SHANEMAC51]

Now the size is 161,696 and I all did was run reports!

in my first database there were 2 tables (5000 records and 15000 records, М:М)
the initial size is 5MB
after running the query 75MB

once it did not condense, after several runs of the request it received 1400MВ

then I couldn't compress it - the computers were weak then, there was a good archive

 

[CJ_London]

I thought you said this was a FE - so not sure why you have tables there unless you mean linked tables?

When doing the alt f11 to open the VBE to perform the Debug/Compile, is it common that it just selects any module? It grabbed to OnActivate event for my newest report.

in my experience it opens to the module you were last working on.

I tried creating an .accde but it said the database was too big.

Not an error message I've come accros and not aware of any size limitations (other than the 2Gb access limit). I presume it compiles OK (which is a requirement). So is it possible you have a corruption? or trying to create the .accde in a location which is short on disk space?

 

[AngelSpeaks]

I thought you said this was a FE - so not sure why you have tables there unless you mean linked tables?


in my experience it opens to the module you were last working on.


Not an error message I've come accros and not aware of any size limitations (other than the 2Gb access limit). I presume it compiles OK (which is a requirement). So is it possible you have a corruption? or trying to create the .accde in a location which is short on disk space?

One table, the rest are linked. Sorry. Last module? May have been the newest report but I made the changes Vlad suggested before. Corruption could be possible, i have plenty of disk space. Thanks