Evolution of a Function: ShowForm() Part 4

This is Part 4 of a series on the evolution of my ShowForm() function.

In this iteration, I've combined several bug fixes that span a couple of years in the actual history of the ShowForm() function.

These types of accumulated bug fixes are one of the main reasons why it's better to use tried and tested code rather than starting from scratch every time you need to solve the same problem. Joel Spolsky alludes to this in his classic article, "Things You Should Never Do, Part 1," where he warns against software product rewrites (emphasis his):

The idea that new code is better than old is patently absurd. Old code has been used. It has been tested. Lots of bugs have been found, and they’ve been fixed. There’s nothing wrong with it. It doesn’t acquire bugs just by sitting around on your hard drive.

With that in mind, let's fix a few bugs.

Fixing the Filter Reset Bug

There was apparently a bug (or perhaps a "feature") whereby Access 2007 would turn off a form's filter when the filter itself was changed.

The fix appears to be to set the filter value before setting the FilterOn property to True. I have no idea whether this is still an issue. I do know that it's not an issue for me though.

Passing OpenArgs to PreShow

In Part 3, we added support for OpenArgs to multi-instance forms.

We needed to do this because there's no way to pass OpenArgs to a new form instance before the form's Open and Load events are raised. Apparently, setting the OpenArgs property of the Form object was not enough to provide access to that value within our custom PreShow() routine.

Instead, I had to make the following changes to the ShowForm() function itself:

Additionally, I also needed to adjust the PreShow() function in the code-behind of the Form_frmMSysObjects class. Here are the BEFORE and AFTER changes. Remember these go in the code modules of any multi-instance forms you want to support:

BEFORE

Public Sub PreShow()
    TabCtl0_Change
End Sub

AFTER

Public Sub PreShow(Optional PreShowArgs As Variant)
Dim PageToOpen As Variant

    On Error GoTo Err_PreShow

    If Not IsMissing(PreShowArgs) Then
        PageToOpen = Parse(PreShowArgs, "Page")
        If Not IsNull(PageToOpen) Then
            Me.TabCtl0.Value = PageToOpen
        End If
    End If

    Me.TabCtl0.Pages("pageSubLines").Visible = (DCount("*", "vCalcArcs", "xlinkfrom=" & Qt(Me.ConceptID)))
    TabCtl0_Change

Exit_PreShow:
    Exit Sub
Err_PreShow:
    Select Case Err.Number
    Case 2165  'You can't hide a control that has the focus.
        Me.TabCtl0.Value = 0
        Resume
    Case Else
    	MsgBox Err.Description, , "Error " & Err.Number
        'LogErr Err, Errors, "Form_ConceptDetail", "PreShow"
    End Select
    Resume Exit_PreShow
End Sub

Improved String Handling

In Part 1 of this series, we introduced a fix for "missing operator" errors.

In the comments section of that article, sharp-eyed reader Indigo noticed a problem with our initial implementation:

Nice function! Just a thought (maybe it will be addressed in a next part), I think the Where value should be trimmed before checking the rightmost value. Otherwise it would not detect the case where there is a space at the end, e.g. "MyTableID = ", right ?

Right you are, Indigo! Nice catch.

To implement this fix, we changed...

If Right(Where, 1) = "=" Then GoTo Exit_ShowForm

...to...

If Right(RTrim$(Where), 1) = "=" Then GoTo Exit_ShowForm

Here's the change as shown in TortoiseHg:

Recap

In this part, we fixed the following three bugs:

The Filter Reset bug
The OpenArgs assignment bug
The Untrimmed Where clause bug

ShowForm() Part 4: Actual Code

The code below has several dependencies on procedures that I keep in a module named WindowFunctions. See Part 3 to get the actual WindowFunctions code.

FormFunctions Module

Option Compare Database
Option Explicit

Private FormCollection As Collection

'https://nolongerset.com/showform-part-4/
'Requires: Private FormCollection As Collection  in module declaration section
'        : KeepFormOnCanvas, CascadeForm function from WindowFunctions module
'        : RemoveForm in Form_Close event of multi-instance forms
Function ShowForm(FormName As String, _
                  Optional Where As String = "", _
                  Optional OpenArgs As Variant)
Dim Frm As Form, Key As String
    On Error GoTo Err_ShowForm

    If Right(RTrim$(Where), 1) = "=" Then GoTo Exit_ShowForm

    Key = FormName & "§" & Where
    If Not IsMissing(OpenArgs) Then Key = Key & "§" & OpenArgs
    On Error Resume Next
    Set Frm = FormCollection(Key)
    On Error GoTo Err_ShowForm
    
    If Not Frm Is Nothing Then
        Frm.SetFocus
        GoTo Exit_ShowForm
    End If
    
    Select Case FormName
    Case "frmMSysObjects"
        Set Frm = New Form_frmMSysObjects
    End Select
    
    
    If Frm Is Nothing Then
        If FormIsOpen(FormName) Then DoCmd.Close acForm, FormName
        DoCmd.OpenForm FormName, acNormal, , Where, , , OpenArgs
        On Error Resume Next
        Set Frm = Forms(FormName)
        On Error GoTo Err_ShowForm
    Else
        If FormCollection Is Nothing Then Set FormCollection = New Collection
        If Len(Where) > 0 Then
            Frm.Filter = Where
            Frm.FilterOn = True
        End If
        On Error Resume Next
        If IsMissing(OpenArgs) Then
            Frm.PreShow
        Else
            Frm.PreShow OpenArgs
        End If
        On Error GoTo Err_ShowForm
        CascadeForm Frm
        Frm.Visible = True
        FormCollection.Add Frm, Key
    End If
    If Not Frm Is Nothing Then KeepFormOnCanvas Frm

Exit_ShowForm:
    Exit Function
Err_ShowForm:
    MsgBox Err.Description, , "Error " & Err.Number
    'LogError Err.Number, Err.Description, "ShowForm", "FormFunctions Module"
    Resume Exit_ShowForm
    Resume
End Function

'Purpose: Maintains the module-level FormCollection
'           by removing window handles from the collection
'           as their associated forms are closed
'Usage: in Form's Close property sheet event: =RemoveForm([Hwnd])
Function RemoveForm(hWnd)
Dim Obj As Object, DoRemove As Boolean
    
    On Error GoTo Err_RemoveForm

    For Each Obj In FormCollection
        If Obj.hWnd = hWnd Then
            DoRemove = True
            Exit For
        End If
    Next Obj
        
    If DoRemove Then
        Set Obj = Nothing
        FormCollection.Remove CStr(hWnd)
    End If

Exit_RemoveForm:
    Exit Function
Err_RemoveForm:
    Select Case Err.Number
    Case Else
        MsgBox Err.Description, , "Error " & Err.Number
        'LogErr Err, Errors, "FormFunctions", "RemoveForm"
    End Select
    Resume Exit_RemoveForm
End Function

'https://nolongerset.com/why-so-lazy-access/
Function FormIsOpen(FormName As String) As Boolean
    FormIsOpen = (SysCmd(acSysCmdGetObjectState, acForm, FormName) <> 0)
End Function

Cover image created with Microsoft Designer