Database Bloat on format Report

[Jeroen3131]

Hi,

I have a bloating database. Each time I "Print Preview" my Report, the database size increases by 25 MB.

The Report consists of 3 subreports, 1 imageControl and 2 textboxes. The image is not embedded, it's link is in the record of the report's source (query).

I do have some simple VBA code in the Report:

 
Option Compare Database
Option Explicit
 
Private Sub VerticallyCenter(ctl As Control)
    Dim lngHeight As Long
    lngHeight = fTextHeight(ctl)
    ' Rounding will result in a 1 to 2 pixel margin of error
    ' of every control before it renders text.
    ctl.TopMargin = ((ctl.Height - lngHeight) / 2)
End Sub
 
Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
    'Assign Label Values in Footer & Header
    Dim lookDept As Variant
    Dim strDept As Variant
    Dim lookModel As Variant
    Dim strModel As Variant
    Dim lookVariantID As Variant
    Dim strVariant As Variant
 
    lookDept = DLookup("DeptID", "qryFilter", "MaxofWorkRevID = TempVars!WISelect")
    strDept = DLookup("Department", "tblDepartments", "DeptID = " & lookDept & "")
 
    lookModel = DLookup("ModelID", "qryFilter", "MaxofWorkRevID = TempVars!WISelect")
    strModel = DLookup("Model", "tblModels", "ModelID = " & lookModel & "")
 
    lookVariantID = DLookup("VariantID", "qryFilter", "MaxofWorkRevID = TempVars!WISelect")
    strVariant = DLookup("Variant", "qryVariant", "VariantID = " & lookVariantID & "")
 
    Me.lblOperationName.Caption = DLookup("Description", "qryFilter", "MaxofWorkRevID = TempVars!WISelect")
    Me.lblModel.Caption = strModel
    Me.txtOperation.Value = DLookup("Operation", "qryFilter", "MaxofWorkRevID = TempVars!WISelect")
    Me.lblVariant.Caption = strVariant
 
    Me.txtFooterOperation.Value = DLookup("Operation", "qryFilter", "MaxofWorkRevID = TempVars!WISelect")
    Me.lblFooterModel.Caption = strModel
    Me.lblFooterOperation.Caption = "Final Quality Check"
    Me.lblFooterVariant.Caption = strVariant
 
 
 
End Sub
 
Private Sub PageFooterSection_Format(Cancel As Integer, FormatCount As Integer)
 
    ' Gathering data for Building Name String for Document
 
    Dim strDocCode As String
    Dim strDocName As String
    Dim strOperation As String
    Dim strOperationDesc As String
    Dim varRevisionNo As Variant
    Dim lookDept As Variant
    Dim strDept As String
    Dim lookModel As Variant
    Dim strModel As String
    Dim strModelShort As String
    Dim lookVariantID As Variant
    Dim strVariant As String
    Dim strDeptShort As String
    Dim strRevShort As String
 
 
    lookDept = DLookup("DeptID", "qryFilter", "MaxofWorkRevID = TempVars!WISelect")
    strDept = DLookup("Department", "tblDepartments", "DeptID = " & lookDept & "")
    strDeptShort = Left(strDept, 1)
 
    lookModel = DLookup("ModelID", "qryFilter", "MaxofWorkRevID = TempVars!WISelect")
    strModel = DLookup("Model", "tblModels", "ModelID = " & lookModel & "")
    strModelShort = DLookup("ModelAbbreviation", "qryFilter", "MaxofWorkRevID = TempVars!WISelect")
 
    lookVariantID = DLookup("VariantID", "qryFilter", "MaxofWorkRevID = TempVars!WISelect")
    strVariant = DLookup("Variant", "qryVariant", "VariantID = " & lookVariantID & "")
 
    strOperation = DLookup("Operation", "qryFilter", "MaxofWorkRevID = TempVars!WISelect")
    strOperationDesc = DLookup("Description", "qryFilter", "MaxofWorkRevID = TempVars!WISelect")
 
    varRevisionNo = DLookup("MaxofWIrevNo1", "qryFilter", "MaxofWorkRevID = TempVars!WISelect")
 
 
    If varRevisionNo > 99 Then
        strRevShort = varRevisionNo
        ElseIf varRevisionNo > 9 Then
        strRevShort = "0" & varRevisionNo
        ElseIf varRevisionNo < 10 Then
        strRevShort = "0" & "0" & varRevisionNo
    End If
 
 
    ' Actual building of the String for the Document Name
 
    strDocCode = "W" & strDeptShort & "-" & strModelShort & "-" & strOperation & "-" & strRevShort
    strDocName = strDocCode & " " & strOperationDesc
 
    Me.txtDocumentName.Value = strDocName
 
End Sub
 
Private Sub PageHeaderSection_Format(Cancel As Integer, FormatCount As Integer)
    If Me.Page = 2 Then
        Me.lblOperationName.Caption = "Safety Sheet"
    Else
        Me.lblOperationName.Caption = DLookup("Description", "qryFilter", "MaxofWorkRevID = TempVars!WISelect")
    End If
    If Me.Page = 3 Then
        Me.lblOperationName.Caption = "Entry Quality Check"
    End If
End Sub
 
Private Sub Report_Close()
    DoCmd.OpenForm "MainForm", acNormal, "", "", , acNormal
End Sub
 
 
Private Sub ReportFooter_Format(Cancel As Integer, FormatCount As Integer)
 
    ' Gathering data for Building Name String for Document
 
    Dim strDocCode As String
    Dim strDocName As String
    Dim strOperation As String
    Dim strOperationDesc As String
    Dim varRevisionNo As Variant
    Dim lookDept As Variant
    Dim strDept As String
    Dim lookModel As Variant
    Dim strModel As String
    Dim strModelShort As String
    Dim lookVariantID As Variant
    Dim strVariant As String
    Dim strDeptShort As String
    Dim strRevShort As String
 
 
    lookDept = DLookup("DeptID", "qryFilter", "MaxofWorkRevID = TempVars!WISelect")
    strDept = DLookup("Department", "tblDepartments", "DeptID = " & lookDept & "")
    strDeptShort = Left(strDept, 1)
 
    lookModel = DLookup("ModelID", "qryFilter", "MaxofWorkRevID = TempVars!WISelect")
    strModel = DLookup("Model", "tblModels", "ModelID = " & lookModel & "")
    strModelShort = DLookup("ModelAbbreviation", "qryFilter", "MaxofWorkRevID = TempVars!WISelect")
 
    lookVariantID = DLookup("VariantID", "qryFilter", "MaxofWorkRevID = TempVars!WISelect")
    strVariant = DLookup("Variant", "qryVariant", "VariantID = " & lookVariantID & "")
 
    strOperation = DLookup("Operation", "qryFilter", "MaxofWorkRevID = TempVars!WISelect")
    strOperationDesc = DLookup("Description", "qryFilter", "MaxofWorkRevID = TempVars!WISelect")
 
    varRevisionNo = DLookup("MaxofWIrevNo1", "qryFilter", "MaxofWorkRevID = TempVars!WISelect")
 
 
    If varRevisionNo > 99 Then
        strRevShort = varRevisionNo
        ElseIf varRevisionNo > 9 Then
        strRevShort = "0" & varRevisionNo
        ElseIf varRevisionNo < 10 Then
        strRevShort = "0" & "0" & varRevisionNo
    End If
 
 
    ' Actual building of the String for the Document Name
 
    strDocCode = "W" & strDeptShort & "-" & strModelShort & "-" & strOperation & "-" & strRevShort
    strDocName = strDocCode & " " & strOperationDesc
 
    Me.txtDocName.Value = strDocName
 
End Sub
 
Private Sub ReportHeader_Format(Cancel As Integer, FormatCount As Integer)
 
    VerticallyCenter Me.lblApproved
    VerticallyCenter Me.lblDocnameA
    VerticallyCenter Me.lblOperationA
    VerticallyCenter Me.lblOperationDescription
    VerticallyCenter Me.lblPages
    VerticallyCenter Me.lblRevdateA
    VerticallyCenter Me.lblVariantA
    VerticallyCenter Me.lblRevisionNo
    VerticallyCenter Me.lblB
    VerticallyCenter Me.lblC
    VerticallyCenter Me.lblD
    VerticallyCenter Me.lblE
    VerticallyCenter Me.lblF
    VerticallyCenter Me.lblG
 
    ' Gathering data for Building Name String for Document
 
    Dim strDocCode As String
    Dim strDocName As String
    Dim strOperation As String
    Dim strOperationDesc As String
    Dim varRevisionNo As Variant
    Dim lookDept As Variant
    Dim strDept As String
    Dim lookModel As Variant
    Dim strModel As String
    Dim varColor As Variant
    Dim strModelShort As String
    Dim lookVariantID As Variant
    Dim strVariant As String
    Dim strDeptShort As String
    Dim strRevShort As String
    Dim strRevDate As String
    Dim strRevDateLong As String
    Dim strMachinePicture As String
 
    Dim EngInit As String
    Dim PEDInit As String
    Dim ForInit As String
 
    lookDept = DLookup("DeptID", "qryFilter", "MaxofWorkRevID = TempVars!WISelect")
    strDept = DLookup("Department", "tblDepartments", "DeptID = " & lookDept & "")
    strDeptShort = Left(strDept, 1)
 
    lookModel = DLookup("ModelID", "qryFilter", "MaxofWorkRevID = TempVars!WISelect")
    strModel = DLookup("Model", "tblModels", "ModelID = " & lookModel & "")
    varColor = DLookup("ColorCode", "tblModels", "ModelID = " & lookModel & "")
    strModelShort = DLookup("ModelAbbreviation", "qryFilter", "MaxofWorkRevID = TempVars!WISelect")
 
    lookVariantID = DLookup("VariantID", "qryFilter", "MaxofWorkRevID = TempVars!WISelect")
    strVariant = DLookup("Variant", "qryVariant", "VariantID = " & lookVariantID & "")
 
    strOperation = DLookup("Operation", "qryFilter", "MaxofWorkRevID = TempVars!WISelect")
    strOperationDesc = DLookup("Description", "qryFilter", "MaxofWorkRevID = TempVars!WISelect")
 
    varRevisionNo = DLookup("MaxofWIrevNo1", "qryFilter", "MaxofWorkRevID = TempVars!WISelect")
    strRevDate = DLookup("WIrevDate", "qryFilter", "MaxofWorkRevID = TempVars!WISelect")
    strRevDateLong = Format(strRevDate, "Medium Date")
 
    strMachinePicture = DLookup("MachinePicture", "qryFilter", "MaxofWorkRevID = TempVars!WISelect")
 
    If varRevisionNo > 99 Then
        strRevShort = varRevisionNo
        ElseIf varRevisionNo > 9 Then
        strRevShort = "0" & varRevisionNo
        ElseIf varRevisionNo < 10 Then
        strRevShort = "0" & "0" & varRevisionNo
    End If
 
    EngInit = Nz(DLookup("EngInitial", "tblApprovals", "WorkRevID = Tempvars!WISelect"), "")
    PEDInit = Nz(DLookup("PEDInitial", "tblApprovals", "WorkRevID = Tempvars!WISelect"), "")
    ForInit = Nz(DLookup("ForInitial", "tblApprovals", "WorkRevID = Tempvars!WISelect"), "")
 
 
    ' Actual building of the String for the Document Name
 
    strDocCode = "W" & strDeptShort & "-" & strModelShort & "-" & strOperation & "-" & strRevShort
    strDocName = strDocCode & " " & strOperationDesc
 
 
 
 
 
    'Set Labels
 
    Me.lblDepartment.Caption = strDept
    Me.lblDocnameA.Caption = strDocCode
    Me.lblModelA.Caption = strModel
    Me.lblVariantA.Caption = strVariant
    Me.lblOperationA.Caption = strOperation
    Me.lblOperationDescription.Caption = strOperationDesc
    Me.lblRevdateA.Caption = strRevDateLong
    Me.lblRevisionNo.Caption = varRevisionNo
    Me.lblPages.Caption = Pages
 
    Me.lblEngineeringInitial.Caption = EngInit
    Me.lblPEDInitial.Caption = PEDInit
    Me.lblForemanInitial.Caption = ForInit
 
    Me.chkEng.Value = DLookup("EngApp", "tblApprovals", "WorkRevID = Tempvars!WISelect")
    Me.chkPED.Value = DLookup("PEDApp", "tblApprovals", "WorkRevID = Tempvars!WISelect")
    Me.chkFor.Value = DLookup("ForApp", "tblApprovals", "WorkRevID = Tempvars!WISelect")
 
    Me.Caption = strDocName
    Me.boxColor.BackColor = varColor
    Me.ImageMachine.Picture = strMachinePicture
 
 
End Sub
 
 

I've already tried Compact & Repair several times. The database is reduced by 1-2 kb after each compact.

Because each record of my Report contains a Image, the formatting takes several seconds. Could it be that Acces saves the images in the database in sort of Temporary File? Or is there another problem?

In the attachment a screenshot of the Printed View of the Report is shown.

[Jeroen3131]

Found it! I had an embedded Picture in my Report's Header. It happened to be a high Quality picture (14 MB) of a product. Everytime I've viewed my report, Acces made a backup of that Image and put it in a hidden table "MSysResources". I've deleted the 123 duplicates and now my database is a healthy 8 MB again instead of the 1.5 GB.

For more info:

https://misterslimm.wordpress.com/20...d-image-cache/

[Jeroen3131]

Hmm now I'm trying to write a SQL DELETE statement to delete the last two records from the MSysResources Table. This is the code I have:

Private Sub Report_Close()
 
    'Clear the last two entries from the hidden MSysResources table to avoid Database Bloating.
 
    Dim SQL1 As String
    Dim MsysMax1 As Integer
    Dim MsysMax2 As Integer
 
    MsysMax1 = DMax("Id", "MSysResources")
    MsysMax2 = MsysMax1 - 1
 
    SQL1 = "DELETE FROM MSysResources" & _
            "WHERE Id = MsysMax1" & _ 
            "AND Id = MsysMax2;"
 
    DoCmd.SetWarnings False
    DoCmd.RunSQL SQL1
    DoCmd.SetWarnings True
 
    DoCmd.OpenForm "MainForm", acNormal, "", "", , acNormal
End Sub

Everytime I get an Error in the "FROM" clause but to me the SQL seems alright.

Is it possible that you can't use SQL on a hidden (System) table?

[Rabbit]

That's not it, you've formatted your SQL incorrectly. This is what the SQL engine is seeing:

DELETE FROM MSysResourcesWHERE Id = MsysMax1AND Id = MsysMax2;

Whereas what you want it to see is something like this:

DELETE FROM MSysResources WHERE Id = 10 OR Id = 9;

[Jeroen3131]

MsysMax1 is an Integer, it's the maximum record Id from table MSysResources. So for instance if I have a total of 70 records, MsysMax1 = 70. If I run the code and hover over MsysMax1, the value 70 appears. So that seems to be working.

I've tried this:

    SQL1 = "DELETE FROM MSysResources" & _
          "WHERE Id = " & MsysMax1 & ";"

and also this:

    SQL1 = "DELETE FROM MSysResources" & _
          "WHERE Id = 70;"

Still got the "Syntax error in FROM clause".

[Jeroen3131]

Solved it! There was no space between " and WHERE so my SQL would look like: DELETE FROM MSysResourcesWHERE Id = 70.

This is the final working code:

Private Sub Report_Close()
 
    'Clear the last two entries from the hidden MSysResources table to avoid Database Bloating.
 
    Dim SQL1 As String
    Dim SQL2 As String
    Dim MsysMax1 As Integer
    Dim MsysMax2 As Integer
 
    MsysMax1 = DMax("Id", "MSysResources")
    MsysMax2 = MsysMax1 - 1
 
    SQL1 = "DELETE FROM MSysResources" & _
           " WHERE Id = " & MsysMax1 & ";"
 
    SQL2 = "DELETE FROM MSysResources" & _
           " WHERE Id = " & MsysMax2 & ";"
 
    DoCmd.SetWarnings False
    DoCmd.RunSQL SQL1
    DoCmd.RunSQL SQL2
    DoCmd.SetWarnings True
 
    DoCmd.OpenForm "MainForm", acNormal, "", "", , acNormal
 
End Sub

This method isn't foolproof to clear the last records in the MSysResources table but it works for mine. Now my database doesn't bloat any more!