February 2024 ~ LEARN MS-ACCESS TIPS AND TRICKS

Streamlining Code Database Compacting Utility

a.p.r. pillaiFebruary 29, 2024 No comments

Streamlining Form Module Code in Standalone Class Module.

The Database Compact/Repair Utility.

The 'Compact on Close' Option in Microsoft Access. When enabled under File --> Current Database --> Application Options, this feature automatically compacts the database every time you open and close it. Additionally, you can manually select the Compact/Repair option from the File menu to Compact and Repair the active database. If you need to compact an external file, you can choose the Compact and Repair option from the Database Tools Menu.

If you prefer to refrain from performing the Compact and Repair process daily, you can run the Compact/Repair Utility for multiple Databases together periodically, such as weekly or fortnightly. In this case, you can conveniently select those Databases from the Disk and add them to a ListBox, as illustrated in the form image below.

The ListBox is enabled with the Multi-select option and you may select the required databases from the list and run from the Compact/Repair Command Button. The Selected Databases will be Compacted individually and their File Size will be updated in the second column of the ListBox in Kilobytes.

The FileBrowser Control.

The 'Add Databases' Command Button opens the File Browser Dialog Control and you can select one or more Databases from your disk and add them to the ListBox.

The Compact/Repair Function Running.

The selected files from the Disk are added to the DirectoryList Table, the Source Table of the ListBox. As per your Compact/Repair schedule, you may open this Compact/Repair Utility, select the required files from the ListBox then Click on the 'Compact/Repair' Command Button.

Preparing for Compact/Repair.

In the Compact/Repair Utility Program, the Database is first backed up to a temporary location. The default Backup Path shown in the TextBox above the Command Buttons is D:\Tmp\. It is defined in the Default Value Property of the TextBox and used by the Compact/Repair Utility Program.

If you would like to take any Database Backup to a different location then change the path, like C:\Backup\ in the TextBox before running the Compact/Repair option.

If you prefer a different location permanently then open the Form in Design View, display the Property Sheet of the TextBox, and change the Default Value Property to your preferred location like D:\Backup\ and see that the last character in the path is a backslash.

Note: When the same database is compacted again the old backup file will be replaced with the new one. Till that time the Backup File will remain safe in that location.

The Compacting Procedure goes through the following steps:

The Source File is Copied to the backup location, to keep a copy of the Database safe, before the Source file is Compacted.
The DBEngine.CompactDatabase() command is executed to perform Compact and Repair operations on the database and repairs the data if Database corruption is detected. In the event of data corruption, there is a potential risk of data loss, and the specific information regarding the errors encountered is preserved in the System Table MSysCompactErrors. To mitigate such situations, it is advisable to restore the data from previously created database backups, if available.
All objects from the source database, including both user-created and system objects, are transferred into a new database. This new temporary database name is "db1.accdb" (or "db1.mdb" depending on the file format) and is located in the designated backup path: D:\tmp\db1.accdb. The replication process excludes the system's temporary work files, ensuring a comprehensive transfer of objects while omitting non-essential temporary data.
Deletes the Source File from its home location.
The Compacted D:\tmp\db1.accdb file is transferred to the home location with its original Database name.

Note: The Access System goes through the same procedure, when you run the Compacting operation directly from the Access System, except the Database Backup procedure.

Streamlined VBA Coding in Standalone Class Module.

Having gained insights into the utility highlighted in the previous introduction, it is now opportune to explore the streamlined event subroutine coding procedure implemented in this specific project. The necessary VBA codes for Event Subroutines are meticulously crafted within a standalone class module, enhancing code maintenance and debugging processes. This organized code structure within the standalone Class Module facilitates easy transportation to other projects, safeguarding valuable work from being entangled with less critical code in form modules. By adopting this streamlined coding approach, the practice of reusing identical code segments across controls of the same type within the form is encouraged, eliminating the need for duplicative coding efforts.

The Command Button Wrapper Class.

There exists a singular Wrapper Class designated for the Command Button Controls, along with an additional Class Module dedicated to the Intermediary or Interface Class. The Interface Class is responsible for generating instances of the Command Button Wrapper Class and facilitating the Command Button Click Events. Customarily, a Collection Object is employed to manage all Command Button Wrapper Class instances. This arrangement allows for the monitoring and capturing of Command Button Click Events triggered within the Compact_Repair Form.

The Command Button Wrapper Class VBA Code.

Option Compare Database
Option Explicit

Private cmdfrm As Form
Private WithEvents cmd As CommandButton

Private strPath As String
Private bkupPath As String
Dim lst As ListBox
Dim lstcount As Integer
Dim xtn As String

'------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'------------------------------------------------------
'Database Compact/Repair Utility
'Author: a.p.r. pillai
'Date  : 20/02/2024
'Rights: All Rights(c) Reserved by www.msaccesstips.com
'------------------------------------------------------

'Form's Property GET/SET Procedures
Public Property Get cmd_Frm() As Form
    Set cmd_Frm = cmdfrm
End Property

Public Property Set cmd_Frm(ByRef cfrm As Form)
    Set cmdfrm = cfrm
End Property

'Command Button Property GET/SET Procedures
Public Property Get c_cmd() As CommandButton
    Set c_cmd = cmd
End Property

Public Property Set c_cmd(ByRef pcmd As CommandButton)
    Set cmd = pcmd
    
    Call DefaultPath
    
End Property

'The Click Event Subroutines
Private Sub cmd_Click()
On Error GoTo cmd_Click_Err
Select Case cmd.Name
  Case "cmdQuit"
    If MsgBox("Close Compact_Repair Form?", vbOKCancel + vbQuestion, "cmd_Click") = vbOK Then
        DoCmd.Close acForm, cmdfrm.Name
        Exit Sub
    End If

    Case "cmdFileDialog"
        Call FileDialog 'Display selected Path & files
        cmdfrm.dbList.Requery
        
    Case "cmdCompact"
        Call DBPrepare
        
    Case "cmdDelete"
        Call DBDelete
        
End Select

cmd_Click_Exit:
Exit Sub

cmd_Click_Err:
MsgBox Err & " : " & Err.Description, , "cmd_Click()"
Resume cmd_Click_Exit
End Sub

Private Sub DBDelete()
'Delete the selected Items from the DirectoryList Table
Dim delCount As Integer
Dim j As Integer
Dim k As Integer
Dim DB As Database
Dim dbName As String
Dim msg As String
Dim Rst As Recordset
Dim opt As Integer

On Error GoTo DBDelete_Err
opt = 0

msg = "1. Delete Selected." & vbCr & vbCr _
& "2. Delete All from List." & vbCr & vbCr _
& "3. Cancel Deletion."
While opt < 1 Or opt > 3
    opt = InputBox(msg, "Select Option.", 3)
Wend
Select Case opt
    Case 1
        GoTo Selected
    Case 2
      msg = "Empty the Database List...?"
      If MsgBox(msg, vbYesNo + vbCritical, "DeleteList()") = vbNo Then
        Exit Sub
      Else
        DoCmd.SetWarnings False
        DoCmd.OpenQuery "DeleteAll_ListQ"
        DoCmd.SetWarnings True
        cmdfrm.dbList.Requery
        cmdfrm.cmdDelete.eabled = False
        Exit Sub
      End If
    Case 3
        Exit Sub
End Select

Selected:
delCount = CheckList()
If delCount > 0 Then
    msg = "Delete " & delCount & " Items." & vbCr & vbCr & "Proceed...?"
    If MsgBox(msg, vbYesNo, "DBDelete()") = vbNo Then
        Exit Sub
    End If
    
    Set DB = CurrentDb
    Set Rst = DB.OpenRecordset("DirectoryList", dbOpenDynaset)
    Set lst = cmdfrm.dbList
    
For j = 0 To lstcount
    If lst.Selected(j) Then
      dbName = lst.Column(0, j)
      Rst.FindFirst "Path = '" & dbName & "'"
      If Not Rst.NoMatch Then
        Rst.Delete
        Rst.Requery
      End If
    End If
Next
Rst.Close
Set Rst = Nothing
Set DB = Nothing

lst.Requery
    MsgBox delCount & " Item(s) Deleted From List.", , "DBDelete()"
Else
    MsgBox delCount & " Item(s) Selected for Deletion!", , "DBDelete()"
End If

DBDelete_Exit:
Exit Sub

DBDelete_Err:
MsgBox Err & " : " & Err.Description, , "DBDelete()"
Resume DBDelete_Exit
End Sub

Private Sub DBPrepare()
'Preparatory Procedure for Compacting
'the selected Databases individually
Dim xselcount As Integer
Dim dbName As String
Dim ldbName As String
Dim strTmp As String
Dim i As Integer
Dim j As Integer
Dim timr As Double
Dim fs, f
Dim lockfile As String
Dim msg As String

bkupPath = cmdfrm!BackupPath
'create a Backup Folder
On Error Resume Next
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(bkupPath)
    If Err = 76 Or Err > 0 Then
       Err.Clear
       fs.createfolder (bkupPath)
    End If

On Error GoTo DBPrepare_Err

'Remove existing workfiles from backup location
xselcount = CheckList()
If xselcount = 0 Then
msg = "Select Database(s) from List for Compacting!"
MsgBox msg, , "DBPrepare()"
    Exit Sub
End If

'Ensure selected database is not active
msg = "Ensure that Selected Databases are not in Use. " _
& vbCrLf & "Proceed...?"

If MsgBox(msg, vbYesNo + vbDefaultButton2 + vbQuestion, _
"DBPrepare()") = vbNo Then
   Exit Sub
End If

'Check the selected database is active or not
'if inactive then submit it to DBCompact() Program.
For j = 0 To lstcount
    If lst.Selected(j) Then
       dbName = Trim(lst.Column(0, j))
       i = InStrRev(dbName, ".")
       xtn = Mid(dbName, i) 'extract extension
       lockfile = IIf(xtn = ".mdb", "ldb", "laccdb")
       ldbName = Left(dbName, i)
       ldbName = ldbName & lockfile 'for checking the presense of lock file.
       If Len(Dir(ldbName)) > 0 Then 'database is active
          MsgBox "Database: " & dbName & vbCrLf & "is active. Skipping to the Next in list."
          GoTo nextstep
       End If

    'Prepare for Compacting and to display the status messages.
       msg = "Compact/Repair: " & dbName & vbCrLf & "Proceed...?"
       If MsgBox(msg, vbQuestion + vbDefaultButton2 + vbYesNo, "DBPrepare()") = vbYes Then
            cmdfrm.lblNote.Visible = False
            cmdfrm.lblStat.Caption = "Working, Please wait..."
            DoEvents

    Call DBCompact(dbName) 'Run Compacting

            cmdfrm.lblStat.Caption = ""
            DoEvents

nextstep:
            Sleep 5
        End If
    End If
Next

msg = "Selected Database(s) Compacted Successfully."
MsgBox msg, , "DBPrepare()"

    Sleep 3

cmdfrm.lblNote.Visible = True
cmdfrm.lblStat.Caption = ""


strTmp = bkupPath & "db1" & xtn 'Delete the temporary file
Call KillTempFile(strTmp)

Set fs = Nothing
Set f = Nothing
Set lst = Nothing

DBPrepare_Exit:
Exit Sub

DBPrepare_Err:
MsgBox Err.Description, , "DBPrepare()"
Resume DBPrepare_Exit
End Sub

Private Sub DBCompact(ByVal strdb As String)
'Compact/Repair Database received as Parameter
Dim t As Long
Dim xdir As String
Dim strbk As String
Dim strTmp As String
Dim tmp As String
Dim chkFile As String
Dim msg As String

On Error GoTo dbCompact_Err

tmp = cmdfrm!BackupPath

strTmp = tmp & "db1" & xtn

chkFile = strTmp
Call KillTempFile(chkFile)

t = InStrRev(strdb, "\")
If t > 0 Then
   strbk = Mid(strdb, t + 1)
End If
strbk = tmp & strbk

chkFile = strbk
Call KillTempFile(chkFile)

'Make a Copy in d:\tmp folder for safe keep
msg = "Taking Backup of " & strdb & vbCrLf _
& "to " & tmp
cmdfrm.lblMsg.Caption = msg
DoEvents

'Take a Backup of Original File to the Backup Location
   FileCopy strdb, strbk

msg = "Transferring Objects from " & strdb & vbCrLf _
& "to " & tmp & "db1" & xtn
cmdfrm.lblMsg.Caption = msg
DoEvents

'https://learn.microsoft.com/en-us/office/client-developer/access/desktop-database-reference/dbengine-compactdatabase-method-dao
'Compact Database to D:\tmp\db1.accdb
   DBEngine.CompactDatabase strdb, strTmp
   
' Delete uncompacted Database and Copy Compacted db1.mdb with
' the Original Name
msg = "Creating " & strdb & " from " & tmp & "db1" & xtn
cmdfrm.lblMsg.Caption = msg
DoEvents

'Delete uncompacted file
chkFile = strdb
Call KillTempFile(chkFile)

'Create Compacted File with its original name in its home location
    DBEngine.CompactDatabase strTmp, strdb

msg = strdb & " Compacted/Repaired Successfully."

cmdfrm.lblMsg.Caption = msg
DoEvents

Call dbListUpdate(strdb) 'Update the DirectoryList Table

dbCompact_Exit:
Exit Sub

dbCompact_Err:
MsgBox Err & " : " & Err.Description, , "dbCompact()"
Resume dbCompact_Exit
End Sub

Private Function CheckList() As Integer
'Take selected items Count
Dim k As Integer
Dim xcount As Integer

On Error GoTo CheckList_Err

Set lst = cmdfrm.dbList
lstcount = DCount("*", "DirectoryList")

xcount = 0
For k = 0 To lstcount
If lst.Selected(k) Then
    xcount = xcount + 1
End If
Next

If xcount = 0 Then
   MsgBox "No Database(s)Selected."
   Exit Function
End If

CheckList = xcount

CheckList_Exit:
Exit Function

CheckList_Err:
MsgBox Err & ": " & Err.Description, , "CheckList()"
Resume CheckList_Exit
End Function

Private Sub dbListUpdate(ByVal cmpPath As String)
'Update the File Size of the Database after Compacting
On Error GoTo dbListUpdate_Err
Dim sPath As String
Dim i As Variant
Dim DB As Database
Dim Rst As Recordset
Set DB = CurrentDb
Set Rst = DB.OpenRecordset("DirectoryList", dbOpenDynaset)

Rst.MoveFirst
Rst.FindFirst "Path = '" & cmpPath & "'"
If Not Rst.NoMatch Then
    sPath = Rst!Path
    Rst.Edit
    Rst!FileLengthKB = FileLen(sPath) / 1024 'Db size after compacting
    Rst.Update
End If

Rst.Close
cmdfrm.dbList.Requery

dbListUpdate_Exit:
Set Rst = Nothing
Set DB = Nothing
Exit Sub

dbListUpdate_Err:
MsgBox Err & ": " & Err.Description, , "dbListUpdate()"
Resume dbListUpdate_Exit
End Sub

Private Sub DefaultPath()
Dim strLoc As String
'Default path for CommonDialog Control
   strLoc = CurrentProject.Path & "\*.accdb"
   strPath = strLoc 'Assign to Global Variable strPath
   
End Sub

Private Sub FileDialog()
On Error GoTo cmdFileDialog_Err

'Requires reference to Microsoft Office 12.0 Object Library.
Dim fDialog As Office.FileDialog
Dim DB As DAO.Database
Dim Rst As DAO.Recordset
Dim defPath As String
Dim varFile As Variant
Dim strfiles As String

   'Set up the File Dialog.
   Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
   With fDialog
      'Allow user to make multiple selections of disk files.
      .AllowMultiSelect = True
      .InitialFileName = Dir(strPath)
      .InitialView = msoFileDialogViewDetails
      'Set the title of the dialog box.
      .Title = "Please select one or more files"

      'Clear out the current filters, and add our own.
      .Filters.Clear
      .Filters.Add "Access Databases", "*.mdb; *.accdb"
      .Filters.Add "Access Projects", "*.adp"
      .Filters.Add "All Files", "*.*"
      .FilterIndex = 1
      '.Execute
      'Show the dialog box. If the .Show method returns True, the
      'user picked at least one file. If the .Show method returns
      'False, the user clicked Cancel.
    If .Show = True Then
        Set DB = CurrentDb
        Set Rst = DB.OpenRecordset("DirectoryList", dbOpenDynaset)
        'Add all selected files to the DirectoryList Table
        defPath = ""
      For Each varFile In .SelectedItems
         If defPath = "" Then
            defPath = Left(varFile, InStrRev(varFile, "\"))
            defPath = defPath & "*.*"
            strPath = defPath
         End If
            Rst.AddNew
            Rst![Path] = varFile
            Rst![FileLengthKB] = FileLen(varFile) / 1024
            Rst.Update
      Next
            cmdfrm.cmdDelete.Enabled = True
        Else
            MsgBox "You clicked Cancel in the file dialog box."
        End If
      
   End With

cmdFileDialog_Exit:
Exit Sub

cmdFileDialog_Err:
MsgBox Err & " : " & Err.Description, , "cmdFileDialog_Click()"
Resume cmdFileDialog_Exit
End Sub

Private Sub KillTempFile(ByVal filename As String)
On Error GoTo KillTempFile_Err
'Manage Temporary Files
    If Len(Dir(filename)) > 0 Then
        Kill filename
    End If

KillTempFile_Exit:
Exit Sub

KillTempFile_Err:
MsgBox Err & ": " & Err.Description, , "KillTempFile()"
Resume KillTempFile_Exit
End Sub

The Command Button Wrapper Class starts with the usual Properties the Form Object and Command Button Control declarations. The CommandButton Control is declared and qualified with the Keyword WithEvents for capturing the Click Events when Fired from the Form.

A few local Variables are also declared in the global area of the Class Module followed by the Form and Command Button Get/Set Property Procedures.

Despite four Command Buttons on the Form, a single Click Event Subroutine within the Command Button Wrapper Class suffices. This streamlined approach enables the capture of all four Command Button Clicks within the same Event Subroutine, allowing for the execution of their respective Event Procedures. This efficiency is achievable through the implementation of streamlined Event Procedure coding.

When examining the Event Subroutine Code in order of priority, the initial step involves adding the databases slated for the Compact/Repair procedure to the ListBox. This is accomplished through the Click Event of the Command Button labeled 'Add Databases,' with the name 'CmdFileDialog.' The Click Event, in turn, invokes the FileDialog() Subroutine. The Code Segment is given below:

Private Sub FileDialog()
On Error GoTo cmdFileDialog_Err

'Requires reference to Microsoft Office 12.0 Object Library.
Dim fDialog As Office.FileDialog
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim defPath As String
Dim varFile As Variant
Dim strfiles As String

   'Set up the File Dialog.
   Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
   With fDialog
      'Allow user to make multiple selections of disk files.
      .AllowMultiSelect = True
      .InitialFileName = Dir(strPath)
      .InitialView = msoFileDialogViewDetails
      'Set the title of the dialog box.
      .Title = "Please select one or more files"

      'Clear out the current filters, and add our own.
      .Filters.Clear
      .Filters.Add "Access Databases", "*.mdb; *.accdb"
      .Filters.Add "Access Projects", "*.adp"
      .Filters.Add "All Files", "*.*"
      .FilterIndex = 1
      '.Execute
      'Show the dialog box. If the .Show method returns True, the
      'user picked at least one file. If the .Show method returns
      'False, the user clicked Cancel.
    If .Show = True Then
        Set db = CurrentDb
        Set rst = db.OpenRecordset("DirectoryList", dbOpenDynaset)
        'Add all selected files to the DirectoryList Table
        defPath = ""
      For Each varFile In .SelectedItems
         If defPath = "" Then
            defPath = Left(varFile, InStrRev(varFile, "\"))
            defPath = defPath & "*.*"
            strPath = defPath
         End If
            rst.AddNew
            rst![Path] = varFile
            rst![FileLengthKB] = FileLen(varFile) / 1024
            rst.Update
      Next
            cmdfrm.cmdDelete.Enabled = True
        Else
            MsgBox "You clicked Cancel in the file dialog box."
        End If
      
   End With

cmdFileDialog_Exit:
Exit Sub

cmdFileDialog_Err:
MsgBox Err & " : " & Err.Description, , "cmdFileDialog_Click()"
Resume cmdFileDialog_Exit
End Sub

This is the same Office.FileDialog Control (the File Browser Control) and Program we used in the earlier Episode with the Title External Files' List in Hyperlinks published earlier. If you click on this link you will be directed to the specific part of the Page that gives its function details.

In this scenario, we utilize the DirectoryList Table to store the databases selected from the disk, which subsequently populate the ListBox on the Form. The table encompasses two fields: Path and FileLengthKB. The former accommodates the full pathname of the database, while the latter calculates the file size in kilobytes when added to the table. Following the Compact/Repair operations, this table undergoes updates to reflect the altered file sizes.

Users have the flexibility to select one or more databases from the list and initiate the Compact/Repair process by clicking on the designated Command Button. This action triggers the execution of the DBPrepare() Subroutine, which in turn identifies the selected database(s) in the ListBox and passes them to the DBCompact() Subroutine for the Compact/Repair operation.

The DBPrepare() Subroutine VBA Code.

Private Sub DBPrepare()
'Preparatory Procedure for Compacting
'the selected Databases individually
Dim xselcount As Integer
Dim dbName As String
Dim ldbName As String
Dim strTmp As String
Dim i As Integer
Dim j As Integer
Dim timr As Double
Dim fs, f
Dim lockfile As String
Dim msg As String

bkupPath = cmdfrm!BackupPath
'create a Backup Folder
On Error Resume Next
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(bkupPath)
    If Err = 76 Or Err > 0 Then
       Err.Clear
       fs.createfolder (bkupPath)
    End If

On Error GoTo DBPrepare_Err

'Remove existing workfiles from backup location
xselcount = CheckList()
If xselcount = 0 Then
msg = "Select Database(s) from List for Compacting!"
MsgBox msg, , "DBPrepare()"
    Exit Sub
End If

'Ensure selected database is not active
msg = "Ensure that Selected Databases are not in Use. " _
& vbCrLf & "Proceed...?"

If MsgBox(msg, vbYesNo + vbDefaultButton2 + vbQuestion, _
"DBPrepare()") = vbNo Then
   Exit Sub
End If

'Check the selected database is active or not
'if inactive then submit it to DBCompact() Program.
For j = 0 To lstcount
    If lst.Selected(j) Then
       dbName = Trim(lst.Column(0, j))
       i = InStrRev(dbName, ".")
       xtn = Mid(dbName, i) 'extract extension
       lockfile = IIf(xtn = ".mdb", "ldb", "laccdb")
       ldbName = Left(dbName, i)
       ldbName = ldbName & lockfile 'for checking the presense of lock file.
       If Len(Dir(ldbName)) > 0 Then 'database is active
          MsgBox "Database: " & dbName & vbCrLf & "is active. Skipping to the Next in list."
          GoTo nextstep
       End If

    'Prepare for Compacting and to display the status messages.
       msg = "Compact/Repair: " & dbName & vbCrLf & "Proceed...?"
       If MsgBox(msg, vbQuestion + vbDefaultButton2 + vbYesNo, "DBPrepare()") = vbYes Then
            cmdfrm.lblNote.Visible = False
            cmdfrm.lblStat.Caption = "Working, Please wait..."
            DoEvents

    Call DBCompact(dbName) 'Run Compacting

            cmdfrm.lblStat.Caption = ""
            DoEvents

nextstep:
            Sleep 5
        End If
    End If
Next

msg = "Selected Database(s) Compacted Successfully."
MsgBox msg, , "DBPrepare()"

    Sleep 3

cmdfrm.lblNote.Visible = True
cmdfrm.lblStat.Caption = ""


strTmp = bkupPath & "db1" & xtn 'Delete the temporary file
Call KillTempFile(strTmp)

Set fs = Nothing
Set f = Nothing
Set lst = Nothing

DBPrepare_Exit:
Exit Sub

DBPrepare_Err:
MsgBox Err.Description, , "DBPrepare()"
Resume DBPrepare_Exit
End Sub

The above DBPrepare() Subroutine picks the User selected items individually and passes them to the actual Compacting Subroutine DBCompact() below for Compact/Repair operations and restoring the Compacted Database to its home location.

The DBCompact Subroutine VBA Code.

Private Sub DBCompact(ByVal strdb As String)

'Compact/Repair Database received as Parameter
Dim t As Long
Dim xdir As String
Dim strbk As String
Dim strTmp As String
Dim tmp As String
Dim chkFile As String
Dim msg As String

On Error GoTo dbCompact_Err

tmp = cmdfrm!BackupPath

strTmp = tmp & "db1" & xtn

chkFile = strTmp
Call KillTempFile(chkFile)

t = InStrRev(strdb, "\")
If t > 0 Then
   strbk = Mid(strdb, t + 1)
End If
strbk = tmp & strbk

chkFile = strbk
Call KillTempFile(chkFile)

'Make a Copy in d:\tmp folder for safe keep
msg = "Taking Backup of " & strdb & vbCrLf _
& "to " & tmp
cmdfrm.lblMsg.Caption = msg
DoEvents

'Take a Backup of Original File to the Backup Location
   FileCopy strdb, strbk

msg = "Transferring Objects from " & strdb & vbCrLf _
& "to " & tmp & "db1" & xtn
cmdfrm.lblMsg.Caption = msg
DoEvents

'https://learn.microsoft.com/en-us/office/client-developer/access/desktop-database-reference/dbengine-compactdatabase-method-dao
'Compact Database to D:\tmp\db1.accdb
   DBEngine.CompactDatabase strdb, strTmp
   
' Delete uncompacted Database and Copy Compacted db1.mdb with
' the Original Name
msg = "Creating " & strdb & " from " & tmp & "db1" & xtn
cmdfrm.lblMsg.Caption = msg
DoEvents

'Delete uncompacted file
chkFile = strdb
Call KillTempFile(chkFile)

'Create Compacted File with its original name in its home location
    DBEngine.CompactDatabase strTmp, strdb

msg = strdb & " Compacted/Repaired Successfully."

cmdfrm.lblMsg.Caption = msg
DoEvents

Call dbListUpdate(strdb) 'Update the DirectoryList Table

dbCompact_Exit:
Exit Sub

dbCompact_Err:
MsgBox Err & " : " & Err.Description, , "dbCompact()"
Resume dbCompact_Exit
End Sub

There are three other small supporting Subroutines called from both the DBPrepare() and DBCompact() Subroutines.

The CheckList() Subroutine.

Private Function CheckList() As Integer
'Take selected items Count
Dim k As Integer
Dim xcount As Integer

On Error GoTo CheckList_Err

Set lst = cmdfrm.dbList
lstcount = DCount("*", "DirectoryList")

xcount = 0
For k = 0 To lstcount
If lst.Selected(k) Then
    xcount = xcount + 1
End If
Next

If xcount = 0 Then
   MsgBox "No Database(s)Selected."
   Exit Function
End If

CheckList = xcount

CheckList_Exit:
Exit Function

CheckList_Err:
MsgBox Err & ": " & Err.Description, , "CheckList()"
Resume CheckList_Exit
End Function

The above Subroutine checks whether any Item is selected in the ListBox and takes its count when the 'Compact/Repair' or 'Delete from List' Command Button is Clicked. If found selected then the selected operation is performed.

The dbListUpdate() Subroutine VBA.

Private Sub dbListUpdate(ByVal cmpPath As String)
'Update the File Size of the Database after Compacting
On Error GoTo dbListUpdate_Err
Dim sPath As String
Dim i As Variant
Dim DB As Database
Dim Rst As Recordset
Set DB = CurrentDb
Set Rst = DB.OpenRecordset("DirectoryList", dbOpenDynaset)

Rst.MoveFirst
Rst.FindFirst "Path = '" & cmpPath & "'"
If Not Rst.NoMatch Then
    sPath = Rst!Path
    Rst.Edit
    Rst!FileLengthKB = FileLen(sPath) / 1024 'Db size after compacting
    Rst.Update
End If

Rst.Close
cmdfrm.dbList.Requery

dbListUpdate_Exit:
Set Rst = Nothing
Set DB = Nothing
Exit Sub

dbListUpdate_Err:
MsgBox Err & ": " & Err.Description, , "dbListUpdate()"
Resume dbListUpdate_Exit
End Sub

This Program is Called from the DBCompact() Subroutine to update the File Size in Kilobytes in the ListBox after Compacting the Database.

The DBDelete() Subroutine.

Private Sub DBDelete()
'Delete the selected Items from the DirectoryList Table
Dim delCount As Integer
Dim j As Integer
Dim k As Integer
Dim DB As Database
Dim dbName As String
Dim msg As String
Dim Rst As Recordset
Dim opt As Integer

On Error GoTo DBDelete_Err
opt = 0

msg = "1. Delete Selected." & vbCr & vbCr _
& "2. Delete All from List." & vbCr & vbCr _
& "3. Cancel Deletion."
While opt < 1 Or opt > 3
    opt = InputBox(msg, "Select Option.", 3)
Wend
Select Case opt
    Case 1
        GoTo Selected
    Case 2
      msg = "Empty the Database List...?"
      If MsgBox(msg, vbYesNo + vbCritical, "DeleteList()") = vbNo Then
        Exit Sub
      Else
        DoCmd.SetWarnings False
        DoCmd.OpenQuery "DeleteAll_ListQ"
        DoCmd.SetWarnings True
        cmdfrm.dbList.Requery
        cmdfrm.cmdDelete.eabled = False
        Exit Sub
      End If
    Case 3
        Exit Sub
End Select

Selected:
delCount = CheckList()
If delCount > 0 Then
    msg = "Delete " & delCount & " Items." & vbCr & vbCr & "Proceed...?"
    If MsgBox(msg, vbYesNo, "DBDelete()") = vbNo Then
        Exit Sub
    End If
    
    Set DB = CurrentDb
    Set Rst = DB.OpenRecordset("DirectoryList", dbOpenDynaset)
    Set lst = cmdfrm.dbList
    
For j = 0 To lstcount
    If lst.Selected(j) Then
      dbName = lst.Column(0, j)
      Rst.FindFirst "Path = '" & dbName & "'"
      If Not Rst.NoMatch Then
        Rst.Delete
        Rst.Requery
      End If
    End If
Next
Rst.Close
Set Rst = Nothing
Set DB = Nothing

lst.Requery
    MsgBox delCount & " Item(s) Deleted From List.", , "DBDelete()"
Else
    MsgBox delCount & " Item(s) Selected for Deletion!", , "DBDelete()"
End If

DBDelete_Exit:
Exit Sub

DBDelete_Err:
MsgBox Err & " : " & Err.Description, , "DBDelete()"
Resume DBDelete_Exit
End Sub

To remove some databases from the ListBox, you must select them from the ListBox and Click the 'Delete from List' Command Button. The DBDelete() Subroutine is called and the selected items will be deleted from the DirectoryList Table and refreshes the ListBox to reflect the change.

The KillTempFile() Subroutine.

Private Sub KillTempFile(ByVal filename As String)
On Error GoTo KillTempFile_Err
'Manage Temporary Files
    If Len(Dir(filename)) > 0 Then
        Kill filename
    End If

KillTempFile_Exit:
Exit Sub

KillTempFile_Err:
MsgBox Err & ": " & Err.Description, , "KillTempFile()"
Resume KillTempFile_Exit
End Sub

The Compact/Repair Program creates Temporary Databases for System use and deletes them using the above Subroutine. This Subroutine is called from within the DBPrepare() and DBCompact() Subroutines.

The FLst_ObjInit Interface Class Module VBA Code.

Option Compare Database
Option Explicit

Private cmd As FLst_CmdButton
Private frm As Access.Form
Private Coll As New Collection

'------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'------------------------------------------------------
'Database Compact/Repair Utility
'Author: a.p.r. pillai
'Date  : 20/02/2024
'Rights: All Rights(c) Reserved by www.msaccesstips.com
'------------------------------------------------------

Public Property Get Ini_Frm() As Access.Form
    Set Ini_Frm = frm.m_cFrm
End Property

Public Property Set Ini_Frm(ByRef pFrm As Access.Form)
    Set frm = pFrm
    
    Call Class_Init
End Property

Private Sub Class_Init()
On Error GoTo Class_Init_Err
Dim ctl As Control
Dim listcount As Long
Const EP = "[Event Procedure]"

listcount = DCount("*", "DirectoryList")

'If ListBox is empty then disable
'cmdDelete Command Button
If listcount = 0 Then
    frm.cmdDelete.Enabled = False
Else
    frm.cmdDelete.Enabled = True
End If

For Each ctl In frm.Controls
Select Case TypeName(ctl)
      Case "CommandButton"
        Select Case ctl.Name
            Case "cmdFileDialog", "cmdCompact", _
            "cmdDelete", "cmdQuit"
            
                Set cmd = New FLst_CmdButton
                Set cmd.cmd_Frm = frm
                Set cmd.c_cmd = ctl
        
                    cmd.c_cmd.OnClick = EP
                Coll.Add cmd
                Set cmd = Nothing
        End Select
End Select
Next

Class_Init_Exit:
Exit Sub

Class_Init_Err:
MsgBox Err & " : " & Err.Description, , "Class_Init()"
Resume Class_Init_Exit
End Sub

Private Sub Class_Terminate()
Do While Coll.Count > 0
    Coll.Remove 1
Loop
End Sub

Within the global declaration area, the FLst_CmdButton Class, the Form Object frm, and the Collection Object Coll are declared. This is succeeded by the inclusion of Get/Set Property Procedures for the frm property. In adherence to common practice, the active Form Object is passed from the Form_Load() Event Procedure into the pFrm parameter, subsequently being assigned to the Form Object frm.

Upon obtaining the reference to the active Form object within the Interface Class, in the subsequent phase of the Set Property Procedure, we invoke the Class_Init() Subroutine.

Within the Class_Init() Subroutine, a constant named "EP" is created to represent the [Event Procedure] text. Following this, a check is implemented to determine the status of the DirectoryList Table, which serves as the source data for the ListBox. If the DirectoryList table is empty, the [Delete from List] Command Button on the Form is disabled.

Within the subsequent For...Next Loop, the program iterates through the Command Buttons on the Form. When a Command Button is identified, an individual instance of the Command Button Wrapper Class is instantiated. This instance is then assigned with the respective Control Reference, and the necessary Events, specifically the Click Events in this case, are enabled. These instances are subsequently stored in the Collection Object, for retaining them in memory.

You may take note of the following Statements:

                Set cmd = New FLst_CmdButton
                Set cmd.cmd_Frm = frm
                Set cmd.c_cmd = ctl
        
                    cmd.c_cmd.OnClick = EP
                Coll.Add cmd
                Set cmd = Nothing

The initial statement initiates the creation of an instance of the FLst_CmdButton Class in memory. Its cmd_frm Property is then configured with the active form object frm, and the current Command Button control Reference in ctl is transmitted to the c_cmd Property. When these two properties are armed with the references of the Form and Command Button, the resulting instance of the Command Button Wrapper Class effectively mirrors the properties and characteristics of the corresponding Command Button on the Form.

The subsequent statement, cmd.c_cmd.OnClick = EP is functionally equivalent to specifying the text [Event Procedure] in the OnClick Event Property of the Command Button. Following the activation of the Event Procedure, the current instance of the Wrapper Class is added to the Collection Object in memory. This enables the capturing of the Event when triggered from the Command Button, subsequently executing the associated Event Procedure in the Wrapper Class Module.

You should not ignore the next statement Set cmd = Nothing.

At this point you may be in doubt when we execute the above statement it will erase the Wrapper Class Instance we created in memory.

While the resemblance may be apparent, there is a crucial distinction. The inclusion of this instance of the Wrapper Class Object in the Collection Object ensures that the Collection Object remains active, retaining the Wrapper Class Instance in memory until the Form is closed and subsequently cleared.
The reason we need to execute Set cmd = Nothing is to avoid creating the next CmdButton Wrapper Class Instance for another Command Button on the Form without clearing the previous one from memory. Without this step, attempting to create the second instance of the Command Button Wrapper Class could result in overwriting the earlier instance in the same memory location. Thus, resetting cmd ensures that a new instance can be created without interference with the earlier Instance of the Wrapper Class.
If we don't execute the Set cmd = Nothing then only the last Command Button's Event will remain valid and others will keep overwriting the earlier Instances.
Following the reset of the "cmd" object, the process of creating another instance of the Command Button Wrapper Class involves searching for an available memory area to instantiate a new instance of the Command Button Class. This ensures the proper allocation of memory for the new instance, preventing any potential interference with existing instances.
So, please don't ignore this statement. Since it is a logical issue you may need help finding it so easily when debugging.

The Compact_Repair Form Module VBA Code.

Option Compare Database
Option Explicit

Dim Obj As New FLst_ObjInit

Private Sub Form_Load()
DoCmd.Restore
Set Obj.Ini_Frm = Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set Obj = Nothing
End Sub

As customary, we have instantiated the Interface Class FLst_ObjInit in the global declaration section of the Form's Class Module. This declaration ensures that all three sets of Class Modules—Wrapper Class, Interface Class, and Form Class Module—are loaded into memory and poised for operation.

In the Form_Load() event procedure, the obj.Ini_Frm property of the Interface Class is assigned the reference to the active Form object, denoted by Me. This initiates a series of actions, and within moments, the system is primed to handle programmed events and their respective functions.

I hope this utility program proves to be a valuable tool for optimizing your Access applications over an extended period, and the best part is, that it comes at no cost.

The Download Link for Compact/Repair Utility is given below:

CompactingRepairing.zip

Streamlining Code Synchronized Forms

a.p.r. pillaiFebruary 14, 2024 No comments

Streamlining Form Module Code in Standalone Class Module.

Synchronized Floating Popup Form.

The article on the Synchronized Floating Popup Form was originally published in February 2009. The notable difference is that once written in the Form Module, the Event Subroutine code is now executed from the Standalone Class Module.

All events triggered from the form and controls, such as TextBoxes and Command Buttons, are now captured in the Standalone Class Module, with the corresponding event subroutines being executed outside the Form Module. This exemplifies a paradigm shift where Form Module VBA codes are run from the Standalone Class Module, resulting in significantly reduced VBA code compared to what is typically written in the Form Module. At this point, the form serves solely for interface design purposes.

VBA Coding, Code Management, and debugging can be done independently without going into the Form Design View and Control's Event Property to get to the required Code in the Form Module. You can always find your Object group-level streamlined Event Subroutine Code, in one place in the Standalone Class Module, which is like one BeforeUpdate() Event Subroutine is only needed for 25 TextBoxes on the Form, even if all 25 of them need different sets of Code. If you already visited the earlier Episodes of this Topic you already know it by now.

Synchronized Floating Popup Forms.

The Employee record is structured into two distinct logical sets of information. The initial part encompasses Official Information, while the subsequent part entails Personal Information, including details, such as address and phone number. To enhance user experience, these two sets of information are displayed in two separate, independent forms. Notably, the Personal Information section is not mandated to remain visible at all times on the screen. Instead, it can be accessed and displayed dynamically by clicking the "Personal Info" command button.

Moreover, as the navigation control advances to the next record on the first Form, it triggers an immediate update of the corresponding data on the second Form, guaranteeing seamless synchronization between the two forms. This ensures that the information displayed on both forms remains consistently aligned as the user navigates through the records.

The second form can be kept from displaying on the Screen all the time, by Clicking on the Close Command Button. It can be displayed by selecting the Personal Info Command Button when needed.

The OnDirty and BeforeUpdate Events are enabled for all TextBoxes and ComboBoxes to safeguard the data integrity.

The first Form has several TextBoxes, two Comboboxes, and two Command Buttons. The second Form has several TextBoxes and a Command Button.

To achieve the desired functionality, we need three Wrapper Classes—one for TextBoxes, one for Command Buttons, and one for ComboBoxes—along with the Intermediary Class Module (Interface Class). The Interface Class is responsible for creating the Wrapper Class instances, initializing them with the corresponding Object references, and saving instances dynamically in a Collection Object in memory. This approach ensures that when the events are triggered on the form, they can be captured in the respective Wrapper Classes, allowing the execution of the required Event Procedures within the Wrapper Class Instances. This modular and organized structure enhances code manageability and promotes effective event handling across different types of controls on the form.

The TextBox Wrapper Class VBA Code.

Option Compare Database
Option Explicit

Private WithEvents Txt As Access.TextBox
Private tfrm As Access.Form
'------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'------------------------------------------------------
'TextBox Events
'Author: a.p.r. pillai
'Date  : 16/01/2024
'Rights: All Rights(c) Reserved by www.msaccesstips.com
'------------------------------------------------------
'======== Form Object Property Procedure =========
Public Property Get t_Frm() As Access.Form
    Set t_Frm = tfrm
End Property

Public Property Set t_Frm(ByRef vFrm As Access.Form)
    Set tfrm = vFrm
End Property

'======== TextBox Object Property Procedure =========
Public Property Get t_txt() As Access.TextBox
    Set t_txt = Txt
End Property

Public Property Set t_txt(ByRef vtxt As Access.TextBox)
    Set Txt = vtxt
End Property

'======== Event Subroutine =========
Private Sub txt_Dirty(cancel As Integer)
If MsgBox("Are you Editing " & Txt.Name & " Field?", vbYesNo + vbCritical, Txt.Name & " Dirty()") = vbNo Then
    cancel = True
End If
End Sub

Private Sub txt_BeforeUpdate(cancel As Integer)
If MsgBox("Save the Changes " & Txt.Name & " Field?", vbYesNo + vbCritical, Txt.Name & " Dirty()") = vbNo Then
    cancel = True
End If
End Sub

The TextBox Wrapper Class streamlines the process with just two Event Procedures, each containing a few lines of reusable code. This significantly simplifies the handling of all TextBoxes on both forms. Contrast this with the scenario where you'd have to repetitively write these concise lines of code for each TextBox in both Form Modules. The Wrapper Class approach promotes code efficiency and enhances maintainability by consolidating common functionality in a centralized location.

A crucial aspect worth highlighting is the utilization of the same TextBoxWrapper Class Instances for all TextBoxes across two distinct forms. This showcases the versatility of the new coding approach. This flexibility is particularly beneficial in scenarios involving one or more SubForms within the Main Form, as it allows for a unified and efficient management of TextBox events and functionality, promoting a cohesive and streamlined development process.

The Command Button Wrapper Class VBA Code.

Option Compare Database
Option Explicit

Private WithEvents cmd As Access.CommandButton
Private cFrm As Access.Form
Private uFrm As Access.Form
Private strSQL As String

'------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'------------------------------------------------------
'CommandButton Events
'Author: a.p.r. pillai
'Date  : 16/01/2024
'Rights: All Rights(c) Reserved by www.msaccesstips.com
'------------------------------------------------------
Public Property Get c_Frm() As Access.Form
    Set c_Frm = cFrm
End Property

Public Property Set c_Frm(ByRef vFrm As Access.Form)
    Set cFrm = vFrm
    Set uFrm = Forms("Employee_Sub")
End Property

Public Property Get c_cmd() As Access.CommandButton
    Set c_cmd = cmd
End Property

Public Property Set c_cmd(ByRef vcmd As Access.CommandButton)
    Set cmd = vcmd
End Property

'====Event Subroutines====
Private Sub cmd_Click()
    Select Case cmd.Name
        Case "cmdClose"
            If MsgBox("Close the Main Form?", _
            vbYesNo + vbCritical, cmd.Name & "_Click()") = vbNo Then
                'Do Nothing
            Else
                DoCmd.Close acForm, "Employee_Sub"
                DoCmd.Close acForm, cFrm.Name
            End If
        
        Case "cmdPersonalInfo"
                strSQL = "SELECT Employees.* FROM Employees "
                strSQL = strSQL & "WHERE ([EmployeeID] = " & cFrm![EmployeeID] & ");"
                uFrm.RecordSource = strSQL
                uFrm.Requery
                uFrm.Visible = True
                cFrm.ActiveControl.SetFocus
        
        Case "cmdCloseSub"
                uFrm.Visible = False
    End Select
End Sub

Having two Command Buttons on the Main Form, and an additional one on the Second Form to close it is common. Writing the Command Button Click Event Subroutines in the same Wrapper Class Module as demonstrated above, streamlines the code organization. Each Command Button corresponds to a dedicated Wrapper Class Instance, and these instances are assigned their respective Control References from both forms.

Using control references as keys is crucial for the system to accurately identify the correct instance of the Wrapper Class, ensuring that the appropriate Event Subroutine is executed for each Command Button click. This approach enhances code clarity, maintainability, and reusability across different forms and controls.

The ComboBox Wrapper Class VBA Code.

Option Compare Database
Option Explicit

Private WithEvents cbo As Access.ComboBox
Private bFrm As Access.Form

'-------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'-------------------------------------------------------
'CommandButton Events
'Author: a.p.r. pillai
'Date  : 16/01/2024
'Rights: All Rights(c) Reserved by www.msaccesstips.com
'-------------------------------------------------------
Public Property Get b_Frm() As Access.Form
    Set b_Frm = bFrm
End Property

Public Property Set b_Frm(ByRef vFrm As Access.Form)
    Set bFrm = vFrm
End Property

Public Property Get b_cbo() As Access.ComboBox
    Set b_cbo = cbo
End Property

Public Property Set b_cbo(ByRef vcbo As Access.ComboBox)
    Set cbo = vcbo
End Property

'==== ComboBox Event Subroutine ====
Private Sub cbo_Dirty(cancel As Integer)
If MsgBox("Are you Editing " & cbo.Name & " Control?", _
vbYesNo + vbCritical, cbo.Name & " Dirty()") = vbNo Then
    cancel = True
End If
End Sub

Private Sub cbo_BeforeUpdate(cancel As Integer)
If MsgBox("Save the Changes " & cbo.Name & " Control?", _
vbYesNo + vbCritical, cbo.Name & " Dirty()") = vbNo Then
    cancel = True
End If
End Sub

There are two Combo Boxes on the Main Form. The Comboboxes are also enabled with the OnDirty() and BeforeUpdate() Event Subroutines to safeguard the data from unintentional changes or to apply changes with the User's consent.

The Interface Class Module VBA Code.

Option Compare Database
Option Explicit

Private ocmd As ClsCmdButton 'Wrapper Class
Private oTxt As ClsTextBox   'Wrapper Class
Private ocbo As ClsCombo     'Wrapper Class

Private WithEvents Frm As Access.Form 'Employees_Main
Private sFrm As Access.Form 'Employee_Sub

Private coll As New Collection
Private strSQL As String

'------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'------------------------------------------------------
'Wrapper Classes Initialization
'Author: a.p.r. pillai
'Date  : 16/01/2024
'Rights: All Rights(c) Reserved by www.msaccesstips.com
'------------------------------------------------------

Public Property Get i_Frm() As Access.Form
    Set i_Frm = Frm
End Property

Public Property Set i_Frm(ByRef vFrm As Access.Form)
    Set Frm = vFrm
    
    Call Class_Init
End Property

Private Sub Class_Init()
Dim ctl As Control
Const EP = "[Event Procedure]"

'Open the 2nd Form
DoCmd.OpenForm "Employee_Sub", , , , , acHidden

'Assign the Form Reference to sFrm Object
Set sFrm = Forms("Employee_Sub")

'Enable the OnCurrent Event of the Employees_Main Form
Frm.OnCurrent = EP

For Each ctl In Frm.Controls 'Employees_Main Form Controls
    Select Case TypeName(ctl)
        Case "CommandButton"
        
          Select Case ctl.Name '
            Case "cmdClose", "cmdPersonalInfo"
                Set ocmd = New ClsCmdButton 'Create new instance
                Set ocmd.c_Frm = Frm 'Assign Main Form Reference
                Set ocmd.c_cmd = ctl 'Pass current CommandButton Object Reference
                    ocmd.c_cmd.OnClick = EP 'Enable OnClick Event
                    coll.Add ocmd 'Add the instance to Collection Object
                Set ocmd = Nothing 'Reset Wrapper Class instance
          End Select
          
            Case "TextBox"
                Set oTxt = New ClsTextBox
                Set oTxt.t_Frm = Frm
                Set oTxt.t_txt = ctl
                    oTxt.t_txt.OnDirty = EP
                    oTxt.t_txt.BeforeUpdate = EP
                    oTxt.t_txt.BackColor = RGB(&HFF, &HF2, &H0)
                    oTxt.t_txt.BackStyle = 0
                    coll.Add oTxt
                Set oTxt = Nothing
                
            Case "ComboBox"
                Set ocbo = New ClsCombo
                Set ocbo.b_Frm = Frm
                Set ocbo.b_cbo = ctl
                    ocbo.b_cbo.OnDirty = EP
                    ocbo.b_cbo.BeforeUpdate = EP
                    ocbo.b_cbo.BackColor = RGB(&HFF, &HF2, &H0)
                    ocbo.b_cbo.BackStyle = 0
                    coll.Add ocbo
                Set ocbo = Nothing

    End Select
Next

For Each ctl In sFrm.Controls 'Employees_Sub Form Controls
    Select Case TypeName(ctl)
        Case "CommandButton"
        
          Select Case ctl.Name
            Case "cmdCloseSub"
                Set ocmd = New ClsCmdButton 'Instantiate
                Set ocmd.c_Frm = sFrm
                Set ocmd.c_cmd = ctl
                    ocmd.c_cmd.OnClick = EP
                    
                    coll.Add ocmd           'Add to Collection
                Set ocmd = Nothing
          End Select
          
            Case "TextBox"
                Set oTxt = New ClsTextBox   'Instantiate
                Set oTxt.t_Frm = sFrm
                Set oTxt.t_txt = ctl
                    oTxt.t_txt.OnDirty = EP
                    oTxt.t_txt.BeforeUpdate = EP
                    oTxt.t_txt.BackColor = RGB(&HFF, &HF2, &H0)
                    oTxt.t_txt.BackStyle = 0
                    coll.Add oTxt           'Add to Collection
                Set oTxt = Nothing
    End Select
Next

End Sub

Private Sub frm_Current()
If IsLoaded("Employee_Sub") Then
   strSQL = "SELECT Employees.* FROM Employees "
   strSQL = strSQL & "WHERE ([EmployeeID] = " & Frm![EmployeeID] & ");"
   sFrm.RecordSource = strSQL
   Frm.SetFocus
End If

Private Sub Class_Terminate()
Set Frm = Nothing
Set sFrm = Nothing
Do While coll.Count > 0
    coll.Remove 1
Loop

End Sub

The Wrapper Classes are declared as Properties of the Interface Class. Two Form Object Properties are declared to scan for Controls on Employees_Main and Employee_Sub Forms.

The Frm Object is qualified with the Keyword WithEvents to enable the OnCurrent Event of the Employees_Main Form to update the Employee_Sub Form data based on the movement of Records on the Main Form.

The Collection Object and a String Variable strSQL are Properties declared in the Global Area.

The Property Procedures for the Frm Object are declared next to receive the Main From Object Reference from the Form_Load() Event Procedure of the Employees_Main Form. After assigning the Main Form Reference to the Frm Object the Class_Init Subroutine is called for creating the Wrapper Class Instances and Initializing Procedures.

At the beginning of the Class_Init() Subroutine the Employee_Sub Form is open in Hidden Mode and kept in memory. The sFrm Form object is assigned with the Reference of the Employee_Sub Form.

The following statement enables the Main Form's OnCurrent Event to fire the Event when the record is moved from one to the other through the Record Navigation Control:

'Enable the OnCurrent Event of the Employees_Main Form
Frm.OnCurrent = EP

There are three sets of Objects on the Employees_Main Form: TextBoxes, Command Buttons, and Combo Boxes. The Employee_Sub Form has a few TextBoxes and a single Command Button to create Wrapper Class Instances and assign their related Object References.

The following VBA Code Segment scans the Employees_Main Form for Textboxes, Command Buttons, and ComboBoxes:

For Each ctl In Frm.Controls 'Employees_Main Form Controls
    Select Case TypeName(ctl)
        Case "CommandButton"
        
          Select Case ctl.Name '
            Case "cmdClose", "cmdPersonalInfo"
                Set ocmd = New ClsCmdButton     'Create new instance
                Set ocmd.c_Frm = Frm            'Assign Main Form Reference
                Set ocmd.c_cmd = ctl            'Pass current CommandButton Object Reference
                    ocmd.c_cmd.OnClick = EP     'Enable OnClick Event
                    coll.Add ocmd               'Add the instance to Collection Object
                Set ocmd = Nothing              'Reset Wrapper Class instance
          End Select
          
            Case "TextBox"
                Set oTxt = New ClsTextBox
                Set oTxt.t_Frm = Frm
                Set oTxt.t_txt = ctl
                    oTxt.t_txt.OnDirty = EP
                    oTxt.t_txt.BeforeUpdate = EP
                    
                    oTxt.t_txt.BackColor = RGB(255, 242,0) 'Yellow Color
                    oTxt.t_txt.BackStyle = 0
                    
                    coll.Add oTxt
                Set oTxt = Nothing
                
            Case "ComboBox"
                Set ocbo = New ClsCombo
                Set ocbo.b_Frm = Frm
                Set ocbo.b_cbo = ctl
                    ocbo.b_cbo.OnDirty = EP
                    ocbo.b_cbo.BeforeUpdate = EP
                    
                    ocbo.b_cbo.BackColor = RGB(255, 242, 0) 'Yellow Color
                    ocbo.b_cbo.BackStyle = 0
                    
                    coll.Add ocbo
                Set ocbo = Nothing

    End Select
Next

The provided code segment examines the existence of Command Button, TextBox, and ComboBox controls on the Employees_Main Form. It creates instances of the corresponding Wrapper Classes, sets the Wrapper Class property values, enables the controls' OnDirty and BeforeUpdate Events, and then adds these instances to the Collection Object in memory. This systematic approach ensures that the necessary controls are properly encapsulated within their respective Wrapper Class Instances and facilitates organized event handling through the centralized Collection.

The dynamic modification of TextBox and ComboBox controls' BackColor and BackStyle property values enhances user interaction on the form. Specifically, these properties are adjusted to highlight the background of the controls in yellow when they become active. The BackStyle property is set to Transparent, ensuring that the yellow background color is only displayed when the TextBox or ComboBox is in focus, contributing to a visually intuitive and user-friendly design.

The Employee_Sub Form Controls VBA Code Segment.

For Each ctl In sFrm.Controls 'Employees_Sub Form Controls
    Select Case TypeName(ctl)
        Case "CommandButton"
        
          Select Case ctl.Name
            Case "cmdCloseSub"
                Set ocmd = New ClsCmdButton 'Instantiate
                Set ocmd.c_Frm = sFrm
                Set ocmd.c_cmd = ctl
                    ocmd.c_cmd.OnClick = EP
                    
                    coll.Add ocmd           'Add to Collection
                Set ocmd = Nothing
          End Select
          
            Case "TextBox"
                Set oTxt = New ClsTextBox   'Instantiate
                Set oTxt.t_Frm = sFrm
                Set oTxt.t_txt = ctl
                    oTxt.t_txt.OnDirty = EP
                    oTxt.t_txt.BeforeUpdate = EP
                    
                    oTxt.t_txt.BackColor = RGB(&HFF, &HF2, &H0)
                    oTxt.t_txt.BackStyle = 0
                    
                    coll.Add oTxt           'Add to Collection
                Set oTxt = Nothing
    End Select
Next

The second form exclusively contains TextBoxes, each equipped with OnDirty() and BeforeUpdate() Event Procedures, akin to the Main Form. If additional Event Subroutines are deemed necessary for these TextBoxes, beyond OnDirty() and BeforeUpdate(), they can be conveniently authored within the same Wrapper Class. The beauty of this approach lies in the uniqueness of references assigned to each TextBox. This ensures that the references are tied to the respective objects, enabling the system to accurately locate and execute the correct Event Procedure for each TextBox through the associated Wrapper Class Instances.

The Form_Current() Event Subroutine.

Private Sub frm_Current()
If IsLoaded("Employee_Sub") Then
   strSQL = "SELECT Employees.* FROM Employees "
   strSQL = strSQL & "WHERE ([EmployeeID] = " & Frm![EmployeeID] & ");"
   sFrm.RecordSource = strSQL
   Frm.SetFocus
End If
End Sub

Private Sub Class_Terminate()
Set Frm = Nothing
Set sFrm = Nothing
Do While coll.Count > 0
    coll.Remove 1
Loop
End Sub

When the Record Navigation Button is employed to navigate to the next or previous record on the Employees_Main Form, the Form_Current() Event is triggered and captured by the Subroutine frm_Current() provided above. In response, a Query SQL is formulated using the EmployeeID value as a key to filter the data from the employee record. Subsequently, this Query is utilized as the Record Source of the second form, Employee_Sub, ensuring the synchronization of the Personal Info Data with the record currently displayed on the Employees_Main Form. This approach facilitates seamless coordination between the two forms, providing updated and synchronized information based on the selected record.

The Sub Class_Terminate() Subroutine works like the Form_Unload() Event Subroutine on the Form. When you close the Form, the Form_Unload() Event Procedure fires, if it is present on the Form before the Form is actually closed. This Subroutine clears the Forms declarations, removes all the Wrapper Class Instances from the Collection Object, and finally removes the Collection Object itself from memory.

The Employees_Main Form Module Code.

Option Compare Database
Option Explicit

Private obj As New ClsObject_Init

Private Sub Form_Load()
    Set obj.i_Frm = Me
End Sub

Private Sub Form_Unload(cancel As Integer)
    Set obj = Nothing
If IsLoaded("Employee_Sub") Then
  DoCmd.Close acForm, "Employee_Sub"
End If
End Sub

Declares the Interface Object ClsObj_Init Class Module and Instantiates it with the Object Name obj in the Global Declaration area of the Form Module.

In the Form_Load() Event Subroutine the Form Object Me is passed to the Frm Property of ClsObj_Init Interface Class through the Property Procedure i_Frm() in this statement Set obj.i_frm = Me.

In the Form_Unload() Event Procedure the statement Set obj = Nothing attempts to clear ClsObj_Init Interface Class from memory. This will trigger the Sub Class_Terminate() Subroutine we discussed above.

Hope you enjoyed the new way of Coding and your feedback is highly appreciated.

Demo Database Download

SynchronizedForms2K.zip

One TextBox and Three Wrapper Class Instances.

a.p.r. pillaiFebruary 01, 2024 No comments

Streamlining Event Subroutines in Standalone Class Module.

The Standalone Class Module Coding Rules overview.

One Wrapper Class Module for several objects of the same Type (E.g.: TextBox) on the Form. Example: ClsTextBox.

One Event Subroutine per Event for several Objects of the same type on the Form.

Example:

Private Sub txt_AfterUpdate()
    Select Case TypeName(Ctl)
       Case "TextBox"
       
          Select Case Ctl.Name 
              Case "Text0"
                  'Code
                  
              Case "Text2","Text4","Text6"
                  'Code
                  
              Case "Text8"
                  'Code
          End Select
          
   End Select
End Sub

Wrapper Class instances are established, with an individual Instance designated for each TextBox on the form. Subsequently, each Instance is assigned its respective TextBox Reference.

Let us look at the Class_Init() Subroutine VBA Code and see how this process is initiated in the Intermediary (or Interface) Class Module - ClsObj_Init.

 Private Sub Class_Init()
 Dim Ctl As Control
 
 For Each Ctl In Frm.Controls
   Select Case TypeName(Ctl)
     Case "TextBox"
       Set txt = New ClsTextBox
       Set txt.m_frm = Frm
       Set txt.m_txt = Ctl
       
           txt.m_txt.AfterUpdate = "[Event Procedure]"
           
           Coll.Add txt
       Set txt = Nothing
   End Select
Next

The above Subroutine modifies the AfterUpdate Event Property Values with the text [Event Procedure] option at run-time.
The Enter Key press, after typing something in the TextBox, fires the AfterUpdate Event.
If the AfterUpdate Property is assigned with a Macro or Public Function Name then the Event will call the Macro or Function directly. The Form doesn't need a Class Module to run these two options.
As we are all aware, typically, we write one Subroutine per Event and create one Wrapper Class Instance per TextBox. However, what happens if we deviate from this convention and create three Wrapper Class Instances, with AfterUpdate Event Subroutine, for a single TextBox (e.g., Text0) and assign all three Instances with the same Text0 Reference (the Memory Address of Text0 TextBox)?

How does the AfterUpdate Event fire from all three Instances? All of them together or one after the other?
What will happen if three different Macro Names or Function Names are assigned to the AfterUpdate Property, for all three Wrapper Class Instances, like the example Code segment shown below:
```
	For j = 1 To 3 'To create three Instances
             Set ctxt = New ClsTextBox
             Set ctxt.txt = ctl 'Text0 Reference
                 ctxt.param = j
                    
                'Macro1, Macro2, Macro3
    		 ctxt.txt.AfterUpdate = "Macro" & CStr(j) 

                 coll.Add ctxt
             Set ctxt = Nothing
        Next
```
To conduct this experiment and explore the outcomes, we require a TextBox on a Form named Text0, along with the TextBox Wrapper Class Module and the Intermediary (or Interface) Class Module to set up the necessary elements.

The Image of the Form is given below:

Wrapper Class Module: ClsTextBox VBA Code.

Option Compare Database
Option Explicit

Public WithEvents txt As Access.TextBox
Public param As Integer

Private Sub txt_AfterUpdate() 
Dim x As Variant
Dim msg As String

msg = "INSTANCE OF " & UCase(txt.Name)
Select Case param
    Case 1
        'DoCmd.RunMacro "Macro1"
        'x = DisplayText1()

        MsgBox "1st " & msg
    Case 2
        'DoCmd.RunMacro "Macro2"
        'x = DisplayText2()

        MsgBox "2nd " & msg
    Case 3
        'DoCmd.RunMacro "Macro3"
        'x = DisplayText3()

        MsgBox "3rd " & msg
End Select
End Sub

Review of Wrapper Class Code.

The TextBox Object Txt is declared with Public Scope and qualified with the Keyword WithEvents. There is another Property param also declared with Public Scope.

Following this, the Sub txt_AfterUpdate() Event procedure will execute three times consecutively. This occurs for the same event procedure but originates from three distinct Wrapper Class instances. The execution order aligns with the sequential creation of the instances, starting with the first instance, followed by the second, and concluding with the third.

To discern the order of Wrapper Class instance creation and execution sequence, a sequence number is passed as a parameter to the param variable. When the AfterUpdate event subroutine is executed, the number within the param variable is displayed in a message text. This approach allows us to identify from which Wrapper Class instance the message is displayed and in what order.

The Macro and Function Name demo running VBA Code lines are temporarily disabled for test-running the [Event Procedure] alone.

The Intermediary or Interface Class Module ClsObj_Init VBA Code.

Option Compare Database
Option Explicit

Private ctxt As ClsTextBox
Private frm As Form

Private WithEvents cmd As CommandButton
Dim coll As New Collection

Public Property Get m_Frm() As Form
    Set m_Frm = frm
End Property

Public Property Set m_Frm(ByVal vFrm As Form)
    Set frm = vFrm
    
    Call Class_Init
End Property

Private Sub Class_Init()
Dim ctl As Control
Dim j As Integer
Const EP = "[Event Procedure]"
    
For Each ctl In frm.Controls
    Select Case TypeName(ctl)
        Case "TextBox"
            Select Case ctl.Name
                Case "Text0" 'The Text0 Object Reference.
                  For j = 1 To 3
                    Set ctxt = New ClsTextBox
                     Set ctxt.txt = ctl
                        ctxt.param = j
                        
    'ctxt.txt.AfterUpdate = "Macro" & CStr(j) 'Macro1, 2, 3
    'ctxt.txt.AfterUpdate = "=DisplayText" & CStr(j) & "()"

    ctxt.txt.AfterUpdate = "[Event Procedure]"
                        coll.Add ctxt
                    Set ctxt = Nothing
                  Next
            End Select
        Case "CommandButton"
          Select Case ctl.Name
            Case "CmdClose"
              Set cmd = frm.cmdClose
                cmd.OnClick = "[Event Procedure]"
          End Select
    End Select
 Next
End Sub

Private Sub cmd_Click()
DoCmd.Close acForm, frm.Name
End Sub

As usual, the first two lines of Code in the global declaration area, the TextBox Wrapper Class Object ctxt, and the Form object frm are declared.

A Command Button on the form requires a Click Event to close the form. To capture the event in the Interface Class Module when fired on the form, a Command Button object is declared in the global area, qualified with the keyword WithEvents. It's important to note that since there is only one Command Button on the form, handling the Click Event in the Interface Class Module can be done directly without the need to create a Wrapper Class.

A Collection object is declared to store all TextBox object instances in memory, enabling the capture of events fired on the form and the execution of the corresponding event subroutines.

When the Form is open the Form Object is passed to the Form object's Set Property Procedure. The Object reference is assigned to the frm Property.

Next, the Class_Init() Subroutine is called.

In the For...Next loop, the Code scans the Form for the Text0 TextBox. Once found, the inner For...Next loop is configured to run for three cycles, creating three instances of the Wrapper Class Object ctxt. All three instances are assigned with the same Text0 Control's reference. It's worth noting that this can be achieved without using the For...Next loop by duplicating the code three times. However, for consistency, we adhere to the coding style employed thus far.

When the Wrapper Class instances are created, the sequence number is passed to the Property ctxt.param. This number is then displayed in the MsgBox within the AfterUpdate Subroutine. This approach proves beneficial for identifying the execution order of the Event Subroutines, mirroring the sequence in which the instances are created.

If you manually create an AfterUpdate Event Subroutine in the Form Module in addition to the three instances, that Form Module Event Subroutine will execute first, followed by the Subroutines in the Wrapper Class instances. This sequence ensures that any manually added code in the Form Module takes precedence over the dynamically created instances.

As you have seen in the AfterUpdate Event Subroutine we can check the sequence number in the param Property (see the Code segment given below) and based on its sequential order it is possible to call three different Sets of Programs when a single AfterUpdate or similar Event fires.

msg = "INSTANCE OF " & UCase(txt.Name)
Select Case param
    Case 1
        'DoCmd.RunMacro "Macro1"
        'x = DisplayText1()

        MsgBox "1st " & msg
    Case 2
        'DoCmd.RunMacro "Macro2"
        'x = DisplayText2()

        MsgBox "2nd " & msg
    Case 3
        'DoCmd.RunMacro "Macro3"
        'x = DisplayText3()

        MsgBox "3rd " & msg
End Select

The test run of the Event Subroutine Image (message from the first Instance) is given below:

The provided screenshot captures the moment when the message is displayed from the AfterUpdate() Event Subroutine, indicating that the message originates from the first instance of the ClsTextBox Wrapper Class. Subsequently, two similar messages follow, each indicating the 2nd and 3rd instances, respectively.

Experiments with Macro Names: Macro1, Macro2, and Macro3

In the upcoming experiment, we will replace the text [Event Procedure] with the Macro names Macro1, Macro2, and Macro3 to trigger the AfterUpdate Event. It's important to note that no alterations will be made to the TextBox Wrapper Class VBA Code. Below is the modified code for the Class_Init() Subroutine in the Interface Module for your reference.

Private Sub Class_Init()
Dim ctl As Control
Dim j As Integer
Const EP = "[Event Procedure]"
    
For Each ctl In frm.Controls
    Select Case TypeName(ctl)
        Case "TextBox"
            Select Case ctl.Name
                Case "Text0"
                  For j = 1 To 3
                    Set ctxt = New ClsTextBox
                     Set ctxt.txt = ctl
                        ctxt.param = j
                        
        'Macro1, Macro2, Macro3              
    	ctxt.txt.AfterUpdate = "Macro" & CStr(j)
        
                       coll.Add ctxt
                    Set ctxt = Nothing
                  Next
            End Select
        Case "CommandButton"
          Select Case ctl.Name
            Case "CmdClose"
              Set cmd = frm.cmdClose
                cmd.OnClick = "[Event Procedure]"
          End Select
    End Select
 Next
End Sub

All three Macros have a Message Box Function that displays a message with the Macro Version Number 1, 2, and 3 as shown below:

In the Initializing Class_Init() Subroutine, the AfterUpdate Property is assigned with the Macro Names: Macro1, Macro2, and Macro3 as we normally do with the [Event Procedure] Option.

Following the modifications in the VBA code, input some text into the TextBox and press the Enter key to trigger the AfterUpdate event. Subsequently, you will be greeted with a message from Macro3 exclusively. As previously emphasized, it's crucial to note that the Form Class Module or the Wrapper Class does not play a role in the invocation of the macro or function from the AfterUpdate or any other event property.

Running Public Functions: =DisplayText1(), =DisplayText2(), =DisplayText3().

It's worth noting that there are three functions in the standard module bearing the names mentioned above. Each of these functions utilizes the MsgBox function to display text, identifying the sequence number as depicted in their respective names.

If you substitute the AfterUpdate event-enabling line in the Class_Init() subroutine with the provided line of code and subsequently open the form, triggering the AfterUpdate event will reveal that the displayed message emanates solely from the function DisplayText3().

ctxt.txt.AfterUpdate = "=DisplayText" & CStr(j) & "()"

In contrast to the [Event Procedure] option, which invokes the RaiseEvent action, the macro and function name coding pertains to the direct modification of the AfterUpdate Event Property of the TextBox on the Property Sheet. This manual alteration involves replacing the existing name with three different names successively, with the final one prevailing.

How to Run Macros or Functions.

Indeed, the experimental approach undertaken served as an extraordinary demonstration, underscoring the crucial point that macro or function names coded in the Event Property are executed directly by the system. The involvement of the Wrapper Class Instance is entirely bypassed in this process. Whether the names are manually written in the Event Property or scripted through the Class_Init() Subroutine, the modifications are consistently made directly to the TextBox Property.

To alleviate potential confusion, a recommended approach is to consistently opt for the [Event Procedure] option and then call the macro or function, if needed, from within the TextBox Wrapper Class Instance-based subroutine. An illustrative example is provided below:

Private Sub txt_AfterUpdate() 
Dim x As Variant

Select Case txt.Name
    Case "Text0"
        'DoCmd.RunMacro "Macro1" ' Run Macro
        'x = DisplayText1()      ' Run Function

        MsgBox "TextBox" & txt.Name
End Select

By adopting this method, clarity is enhanced, and the direct execution of macros or functions from the Event Property remains seamless within the designated TextBox Wrapper Class Instance.