Question

When my database is opened, it shows a form with a “loading bar” that reports the progress of linking external tables and such, before showing a “Main Menu” form. The Main Menu has code that generates a form programmatically behind the scenes with buttons on it, and when that’s done it saves and renames the form, and assigns it as the SourceObject to a subform.

This all works fine and dandy, that is, until I decide to make the buttons actually do something useful. In the loop that generates the buttons, it adds VBA code to the subform-to-be’s module. For some reason, doing that makes VBA finish execution, then stop. This makes the (modal) loading form not disappear as there’s an If statement that executes a DoCmd.Close to close the loading form when it’s done loading. It also breaks functionality that depends on a global variable being set, since the global is cleared when execution halts.

Is there a better way to go about creating buttons that do stuff programmatically, short of ditching Access outright and writing real code? As much as I would love to, I’m forced to do it in Access in case I leave the company so the less tech-savvy employees can still work with it in my absence.

Below are bits and pieces of relevant code, if needed.

Form_USysSplash:

'Code that runs when the form is opened, before any processing.
Private Sub Form_Open(Cancel As Integer)
    'Don't mess with things you shouldn't be.
    If g_database_loaded Then
        MsgBox "Please don't try to run the Splash form directly.", vbOKOnly, "No Touching"
        Cancel = True
        Exit Sub
    End If

    'Check if the user has the MySQL 5.1 ODBC driver installed.
    Call CheckMysqlODBC 'Uses elfin majykks to find if Connector/ODBC is installed, puts the result into g_mysql_installed
    If Not g_mysql_installed Then
        Cancel = True
        DoCmd.OpenForm "Main"
        Exit Sub
    End If
End Sub

'Code that runs when the form is ready to render.
Private Sub Form_Current()

    'Prepare the form
    boxProgressBar.width = 0
    lblLoading.caption = ""

    'Render the form
    DoCmd.SelectObject acForm, Me.name
    Me.Repaint
    DoEvents

    'Start the work
    LinkOMTables
    UpdateStatus "Done!"

    DoCmd.OpenForm "Home"
    f_done = True
End Sub

Private Sub Form_Timer() 'Timer property set to 100
    If f_done Then DoCmd.Close acForm, Me.name
End Sub

Form_Home:

'Code run before the form is displayed.
Private Sub Form_Load()

    'Check if the user has the MySQL 5.1 ODBC driver installed.
    'Header contains an error message and a download link
    If Not g_mysql_installed Then
        FormHeader.Visible = True
        Detail.Visible = False
    Else
        FormHeader.Visible = False
        Detail.Visible = True
        CreateButtonList Me, Me.subTasks
    End If
End Sub

'Sub to create buttons on the form's Detail section, starting at a given height from the top.
Sub CreateButtonList(ByRef frm As Form, ByRef buttonPane As SubForm)
    Dim rsButtons As Recordset
    Dim newForm As Form
    Dim newButton As CommandButton
    Dim colCount As Integer, rowCount As Integer, curCol As Integer, curRow As Integer
    Dim newFormWidth As Integer
    Dim taskFormName As String, newFormName As String

    Set rsButtons = CurrentDb.OpenRecordset("SELECT * FROM USysButtons WHERE form LIKE '" & frm.name & "'")
    If Not rsButtons.EOF And Not rsButtons.BOF Then

        taskFormName = "USys" & frm.name & "Tasks"
        On Error Resume Next
        If TypeOf CurrentProject.AllForms(taskFormName) Is AccessObject Then
            buttonPane.SourceObject = ""
            DoCmd.DeleteObject acForm, taskFormName
        End If
        Err.Clear
        On Error GoTo 0
        Set newForm = CreateForm
        newFormName = newForm.name
        With newForm
            .Visible = False
            .NavigationButtons = False
            .RecordSelectors = False
            .CloseButton = False
            .ControlBox = False
            .width = buttonPane.width
            .HasModule = True
        End With

        rsButtons.MoveLast
        rsButtons.MoveFirst
        colCount = Int((buttonPane.width) / 1584) 'Twips: 1440 in an inch. 1584 twips = 1.1"
        rowCount = Round(rsButtons.RecordCount / colCount, 0)
        newForm.Detail.height = rowCount * 1584
        curCol = 0
        curRow = 0

        Do While Not rsButtons.EOF
            Set newButton = CreateControl(newForm.name, acCommandButton)
            With newButton
                .name = "gbtn_" & rsButtons!btn_name
                .Visible = True
                .Enabled = True
                .caption = rsButtons!caption
                .PictureType = 2
                .Picture = rsButtons!img_name
                .PictureCaptionArrangement = acBottom
                .ControlTipText = rsButtons!tooltip
                .OnClick = "[Event Procedure]"
                'This If block is the source of my headache.
                If Not IsNull(rsButtons!open_query) And rsButtons!open_query <> "" Then
                    newForm.Module.InsertLines newForm.Module.CountOfLines, _
                        "Private Sub gbtn_" & rsButtons!btn_name & "_Click()"
                    newForm.Module.InsertLines newForm.Module.CountOfLines, _
                        "DoCmd.OpenQuery """ & rsButtons!open_query & """"
                    newForm.Module.InsertLines newForm.Module.CountOfLines, _
                        "End Sub" & vbCrLf & vbCrLf
                ElseIf Not IsNull(rsButtons!open_form) And rsButtons!open_form <> "" Then
                    newForm.Module.InsertLines newForm.Module.CountOfLines, _
                        "Private Sub gbtn_" & rsButtons!btn_name & "_Click()"
                    newForm.Module.InsertLines newForm.Module.CountOfLines, _
                        "DoCmd.OpenForm """ & rsButtons!open_form & """"
                    newForm.Module.InsertLines newForm.Module.CountOfLines, _
                        "End Sub" & vbCrLf & vbCrLf
                End If
                .height = 1584
                .width = 1584
                .Top = 12 + (curRow * 1584)
                .Left = 12 + (curCol * 1584)
                .BackThemeColorIndex = 1
                .HoverThemeColorIndex = 4 'Accent 1
                .HoverShade = 0
                .HoverTint = 40 '60% Lighter
                .PressedThemeColorIndex = 4 'Accent 1
                .PressedShade = 0
                .PressedTint = 20 '80% Lighter
            End With
            curCol = curCol + 1
            If curCol = colCount Then
                curCol = 0
                curRow = curRow + 1
            End If
            rsButtons.MoveNext
        Loop
        DoCmd.Close acForm, newForm.name, acSaveYes
        DoCmd.Rename taskFormName, acForm, newFormName
        buttonPane.SourceObject = taskFormName
    End If
End Sub

Answer 1

There is no need to write code while code is running, especially as you are writing essentially the same code over and over again. All you need do is call a function instead of an event procedure.

In your code above write the OnClick event like this:

If Not IsNull(rsButtons!open_query) And rsButtons!open_query <> "" Then
    .OnClick = "=MyOpenForm(""" & rsButtons!open_form & """)"
ElseIf Not IsNull(rsButtons!open_form) And rsButtons!open_form <> "" Then
    .OnClick = "=MyOpenQuery(""" & rsButtons!open_form & """)"
End If

Then create these two permanent (non-generated) functions somewhere the form can see them:

Public Function MyOpenForm(FormName as String)
    DoCmd.OpenForm FormName
End Function

Public Function MyOpenQuery(QueryName as String)
    DoCmd.OpenQuery QueryName
End Function

And ditch the code writing to the module.