title: Programmatically Create a Button That Opens a Form In Access
body: <p>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 <code>SourceObject</code> to a subform.</p>
  
  <p>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 <code>If</code> statement that executes a <code>DoCmd.Close</code> 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.</p>
  
  <p>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.</p>
  
  <p>Below are bits and pieces of relevant code, if needed.</p>
  
  <p>
  Form_USysSplash:</p>
  
  <pre class="lang-vb prettyprint-override"><code>'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
  </code></pre>
  
  <p>Form_Home:</p>
  
  <pre class="lang-vb prettyprint-override"><code>'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 '" &amp; frm.name &amp; "'")
      If Not rsButtons.EOF And Not rsButtons.BOF Then
  
          taskFormName = "USys" &amp; frm.name &amp; "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_" &amp; 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 &lt;&gt; "" Then
                      newForm.Module.InsertLines newForm.Module.CountOfLines, _
                          "Private Sub gbtn_" &amp; rsButtons!btn_name &amp; "_Click()"
                      newForm.Module.InsertLines newForm.Module.CountOfLines, _
                          "DoCmd.OpenQuery """ &amp; rsButtons!open_query &amp; """"
                      newForm.Module.InsertLines newForm.Module.CountOfLines, _
                          "End Sub" &amp; vbCrLf &amp; vbCrLf
                  ElseIf Not IsNull(rsButtons!open_form) And rsButtons!open_form &lt;&gt; "" Then
                      newForm.Module.InsertLines newForm.Module.CountOfLines, _
                          "Private Sub gbtn_" &amp; rsButtons!btn_name &amp; "_Click()"
                      newForm.Module.InsertLines newForm.Module.CountOfLines, _
                          "DoCmd.OpenForm """ &amp; rsButtons!open_form &amp; """"
                      newForm.Module.InsertLines newForm.Module.CountOfLines, _
                          "End Sub" &amp; vbCrLf &amp; 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
  </code></pre>