8
\$\begingroup\$

I have a set of custom event handlers for all my textboxes and combo boxes. The reason for this is my users want the bound form (to SQL Server) to immediately push changes to the recordset, rather than the normal "Save" idea of an Access form. This is the constraint I have to deal with.

As a result, what I am doing is in each form open method I initialize event handlers for the form. I could not find a way to basically override the "default control event handler" and instead have to override each event handler for each type.

In each of the form_current event I want this functionality for I have:

mCustom_FormCurrent me

Which points to the following method:

Public Sub mCustom_FormCurrent(ByRef p_form As Form)
    Set m_EventHandlerManager = New EventHandlerManager
    m_EventHandlerManager.initFormHandlers p_form.Form
End Sub

This sets up a custom event handler for all objects. I put this on the form_current

Class: EventHandlerManager

Public Sub initFormHandlers(p_form As Form)

    Dim ctl

    'types - http://msdn.microsoft.com/en-us/library/office/aa224135(v=office.11).aspx


    Dim txt As EH_TextBox
    Dim cbo As EH_ComboBox

    Set m_TextBoxes = New Collection
    Set m_ComboBoxes = New Collection

    For Each ctl In p_form.Controls

        Select Case ctl.ControlType

            Case acTextBox:
                Set txt = New EH_TextBox
                txt.init ctl, p_form
                m_TextBoxes.Add txt
            Case acComboBox:
                Set cbo = New EH_ComboBox
                cbo.init ctl, p_form
                m_ComboBoxes.Add cbo

            Case default:

        End Select
    Next ctl

End Sub

I have two classes related to this. I structured the EventHandlerManager in such a way as to allow easy addition of other form controls which are also bound (right now I am only concerned with ComboBoxes and TextBoxes).

Class: EH_ComboBox

Option Compare Database
Option Explicit

Private WithEvents m_cboBox As Access.ComboBox
Private m_frm As Access.Form
Private Const Evented As String = "[Event Procedure]"

Public Sub init(p_src, ByRef p_frm As Access.Form)
'As Access.TextBox
    Set m_frm = p_frm
    Set m_cboBox = p_src
    m_cboBox.OnChange = Evented

End Sub


Private Sub m_cboBox_Change()

    On Error GoTo m_cboBox_Change_Error

    Dim i As Integer
    i = 0
Application.Echo False
    m_frm.Recordset.Edit
    m_frm.Recordset.Update
Application.Echo True

    On Error GoTo 0
    Exit Sub

m_cboBox_Change_Error:
    'This resolves an error which happens sometimes - not sure why Resume works but it fixes the .Update causing errors ???
    If i = 0 Then
        i = i + 1
        Resume
    Else
        Application.Echo True
        sendErrorEmail "m_cboBox_Change for " & m_cboBox.Name, err.Description, err.Number, ERROR_DEBUG
    End If
End Sub

Class: EH_TextBox

Option Compare Database
Option Explicit

Private WithEvents m_txtBox As Access.TextBox
Private m_frm As Access.Form
Private Const Evented As String = "[Event Procedure]"



Public Sub init(p_src, ByRef p_frm As Access.Form)
'As Access.TextBox
    Set m_frm = p_frm
    Set m_txtBox = p_src
    m_txtBox.OnExit = Evented
    m_txtBox.OnChange = Evented
    m_txtBox.BeforeUpdate = Evented
    m_txtBox.AfterUpdate = Evented
End Sub

Private Sub m_txtBox_AfterUpdate()

    On Error GoTo m_txtBox_AfterUpdate_Error

    Dim i As Integer
    i = 0

    m_frm.Recordset.Edit
    m_frm.Recordset.Update


    On Error GoTo 0
    Exit Sub

m_txtBox_AfterUpdate_Error:
    'This resolves an error which happens sometimes - not sure why Resume works but it fixes the .Update causing errors ???
    If i = 0 Then
        i = i + 1
        Resume
    Else
        sendErrorEmail "m_txtBox_AfterUpdate for " & m_txtBox.Name, err.Description, err.Number, ERROR_DEBUG
    End If

End Sub

What I am looking for

How can I make this better? This feels like a huge hack, which it kind of is, but barring the use case which is causing this how can I better create custom event handlers for all form controls? I'd have to make a class for each for control I want one for. In my situation there are only two, so it's not "that bad."

Ideally, the form controls would all be inherited from a BaseFormControl class (I made the name up) I could override the AfterUpdate for in a generic sense, and then apply to all form objects. This does not seem to exist though.

\$\endgroup\$
4
\$\begingroup\$

First some general remarks about the code, and then an alternative way to go about this.

  • Underscores have a special meaning in VB. They indicate event procedures and implementations of an interface. You should remove them from your namings. It's a bit confusing to look at. Particularly this.

     Private Sub Form_Current()
        mCustom_FormCurrent Me
    End Sub
    

    It really looks like you're calling an event procedure that resides in the form, but that's not what is actually happening.

  • Also naming issues, I don't like the p_ prefix you're using for parameters. They're locally scoped, so there's no need to prefix them. As a VBA dev, I've come to expect that kind of prefix to mean it's module scoped, like your m_ prefix.

  • The use of On Error GoTo 0 doesn't do anything in this code. That statement disables the error handler in a routine, but you use it directly before exiting. Thus, it doesn't do anything and can be safely removed.

  • In the EventHandlerManager class, you don't declare a type for ctl.

    Public Sub initFormHandlers(p_form As Form)
    
        Dim ctl
    

    This means it's being implicitly declared as a variant. It would be better to declare it as an Access.Control. (But stop what you're thinking, Control doesn't support events...)

  • Script Labels are (necessarily) scoped to their procedure. So, there's no need to spell them out like you have.

    On Error GoTo m_cboBox_Change_Error
    

    This would work just as well and be less clutter.

    On Error GoTo ErrorHandler
    

    Also, if they're standard, you can write code to insert these snippets for you.

  • I don't like how you're trying to Resume in your error handlers. I mean, it's okay if it's working for you, but it would be better to take note of the specific error that needs to be retried for and only retry if it's that particular error. You may want to add more behavior later where it wouldn't be a good thing to simply retry.

    Also, you should rename i to something like errorCount and declare it much closer to where you're using it. Also note that there's no need to set the value to zero. An integer's default value is already zero.

    Private Sub mTextBox_AfterUpdate()
    
        On Error GoTo ErrorHandler
    
        mParentForm.Recordset.Edit
        mParentForm.Recordset.Update
    
        Exit Sub
    
    ErrorHandler:
        'This resolves an error which happens sometimes - not sure why Resume works but it fixes the .Update causing errors ???
        Dim errorCount As Long
        If errorCount = 0 Then
            errorCount = errorCount + 1
            Resume
        Else
            sendErrorEmail "mTextBox_AfterUpdate for " & mTextBox.Name, Err.Description, Err.Number, ERROR_DEBUG
        End If
    
    End Sub
    
  • There is zero benefit to ever declaring an Integer type in VBA. Use a long type instead.


Okay, now let's talk about a better way to do this.

Ideally, the form controls would all be inherited from a BaseFormControl class (I made the name up) I could override the AfterUpdate for in a generic sense, and then apply to all form objects. This does not seem to exist though.

You're absolutely right. Inheritance would be an ideal way to deal with this. Unfortunately, in VBA we can either have inheritance, via interfaces, or events. We can't have them both. So, we'll need another option. Being that you're goal is to not have to create a class for each different type of Access control, I took the following approach. It does have it's cons however. This works only under the assumption that you want all controls to behave exactly the same. Personally, I like your original approach, as it allows you to create controls that react differently to the same events.

  1. I created an EhControl class and copied all of the logic from your two existing control classes. This removed some duplication in declaring the Evented constant and parent form class variable.
  2. I created a private initialize routine for each type of access control.
  3. Create a public initialize control that takes in an Access.Control instead of a TextBox or ComboBox.
  4. Move the Select Case logic into the public Initialize method.

EhControl.cls

Option Compare Database
Option Explicit

Private Const Evented As String = "[Event Procedure]"

Private mParentForm As Access.Form
Private WithEvents mTextBox As Access.TextBox
Private WithEvents mComboBox As Access.ComboBox

Public Sub Initialize(ByRef source As Control, ByRef parentForm As Access.Form)

    Set mParentForm = parentForm

    Select Case source.ControlType
        Case acTextBox:
            InitializeTextBox source
        Case acComboBox:
            InitializeComboBox source
        Case Default:
            'do nothing
    End Select

End Sub

Private Sub InitializeTextBox(ByRef source As TextBox)
    Set mTextBox = source
    mTextBox.OnExit = Evented
    mTextBox.OnChange = Evented
    mTextBox.BeforeUpdate = Evented
    mTextBox.AfterUpdate = Evented
End Sub

Private Sub InitializeComboBox(ByRef source As ComboBox)
    Set mComboBox = source
    mComboBox.OnChange = Evented
End Sub

Private Sub mTextBox_AfterUpdate()

    On Error GoTo ErrorHandler

    mParentForm.Recordset.Edit
    mParentForm.Recordset.Update

    Exit Sub

ErrorHandler:
    'This resolves an error which happens sometimes - not sure why Resume works but it fixes the .Update causing errors ???

    Dim errorCount As Long
    If errorCount = 0 Then
        errorCount = errorCount + 1
        Resume
    Else
        'sendErrorEmail "mTextBox_AfterUpdate for " & mTextBox.Name, Err.Description, Err.Number, ERROR_DEBUG
        MsgBox "Textbox AfterUpdateError"
    End If

End Sub

Private Sub mComboBox_Change()

    On Error GoTo ErrorHandler

    Application.Echo False

    mParentForm.Recordset.Edit
    mParentForm.Recordset.Update

    Application.Echo True

    Exit Sub

ErrorHandler:
    'This resolves an error which happens sometimes - not sure why Resume works but it fixes the .Update causing errors ???

    Dim errorCount As Long
    If errorCount = 0 Then
        errorCount = errorCount + 1
        Resume
    Else
        'sendErrorEmail "mTextBox_AfterUpdate for " & mTextBox.Name, Err.Description, Err.Number, ERROR_DEBUG
        MsgBox "Textbox AfterUpdateError"
    End If
End Sub

Note that there is now an opportunity to extract a subroutine for your error handlers. I have not done this.

  1. Next I created a new ControlEventRegister class. (EventHandlerManager was a bit much for my taste.)
  2. As I stated earlier, the logic in the select case has been removed, so this class is responsible for nothing more than looping through the form that gets passed to InitializeEventHandlers initializing and adding them to a single mControls collection.

ControlEventRegister.cls

Option Compare Database
Option Explicit

Private mControls As Collection

Public Sub IntializeEventHandlers(parentForm As Form)

     Set mControls = New Collection

     Dim eventedControl As EhControl

     Dim ctl As Control
     For Each ctl In parentForm.Controls
        Set eventedControl = New EhControl
        eventedControl.Initialize ctl, parentForm
        mControls.Add eventedControl
     Next ctl
End Sub

Lastly, I wasn't a fan of the sub you had in a regular module to call the EventHandlerManager. I think you could run into some bugs if more than one form was open at a time. I'm not sure, but I don't think it's too much of a burden to add the following code to your forms.

Form Code Behind

Option Compare Database
Option Explicit

Private mEventManager As ControlEventRegister

Private Sub Form_Current()
    Set mEventManager = New ControlEventRegister
    mEventManager.IntializeEventHandlers Me
End Sub
\$\endgroup\$
  • \$\begingroup\$ Ahhh, that way is definitely easier to handle all the events in one class. I never realized you could do something like that, I was trying to think of it as an inheritance thing - never occurred to me that you could setup multiple WithEvents in a single class. You've got a much more streamlined setup here than I did that's for sure! \$\endgroup\$ – enderland Oct 30 '14 at 20:53
  • \$\begingroup\$ The downside is that it could easily turn into the "one class to rule them all." \$\endgroup\$ – RubberDuck Oct 30 '14 at 21:20
1
\$\begingroup\$

Your class has a memory leak: both the form object and the associated event handler object will never get cleared by the garbage collector (well, I'm not 100% sure on where the reference to EventHandlerManager gets stored, but I'm sure it doesn't get cleared and thus the form object doesn't get cleared).

I outlined here on Stack Overflow how you can get reference loops on forms in Microsoft Access because the form object doesn't get deallocated when the form closes if there are open references to it.

Your reference loop works in the following way: the form has a reference to the class EventHandlerManager, EventHandlerManager has a reference to EH_TextBox and EH_ComboBox, EH_ComboBox and EH_Textbox have a reference to the form.

There are several ways to deal with this. One is to listen to form events in your EH_Textbox and EH_ComboBox classes, and remove the reference to the form on the Form_Unload event. However, I'd break the loop in the EventHandlerManager class to avoid redundant code.

EventHandlerManager.cls

Private WithEvents m_frm As Access.Form

Public Sub initFormHandlers(p_form As Form)
    Set m_frm = p_form
    m_frm.OnUnload = "[Event Procedure]"
    'Your existing code
End Sub

Private Sub Form_Unload(Cancel As Integer)
    'Release event handler collections
    Set m_TextBoxes = Nothing
    Set m_ComboBoxes = Nothing
End Sub

I'm new on code review, if this just should be a comment redirecting to an explanation of the bug on SO, please notify me and I'll delete it, if not feel free to edit this notice out

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.