List subforms within another form – MS Access – VBA

I was recently needing to breakdown a very complex form and amongst other things, I needed to extract a list of the subforms contained within it for further analysis.  Below is a simple function I wrote which will return to the immediate pane a listing of the subform names.

Function ListSubFrms(sFrm As String)
On Error GoTo Error_Handler
    Dim ctl             As Access.Control
    Dim frm             As Access.Form

    DoCmd.OpenForm sFrm, acDesign
    Set frm = Forms(sFrm).Form
    For Each ctl In frm.Controls
        Select Case ctl.Properties("ControlType")
            Case acSubform    ', acListBox
                ' ctl.Name 'Will return the given name of the control, not necessarily the actual object name
                ' ctl.Properties("SourceObject") 'Will return the object name
                If ctl.Properties("SourceObject") = "" Then
                    Debug.Print ctl.name
                Else
                    Debug.Print ctl.Properties("SourceObject")
                End If
        End Select
    Next ctl

Error_Handler_Exit:
    On Error Resume Next
    DoCmd.Close acForm, sFrm, acSaveNo
    Set frm = Nothing
    Set ctl = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred." & vbCrLf & vbCrLf & _
            "Error Number: " & Err.Number & vbCrLf & _
            "Error Source: ListSubFrms" & vbCrLf & _
            "Error Description: " & Err.Description, _
            vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

2 responses on “List subforms within another form – MS Access – VBA”

  1. Adrian

    Thank you for your routine ListSubFrms. I’ve not been able to crack this issue before but now I’ve adapted it to list ALL the sub-forms AND the sub-sub-forms – see below:

    ‘List ALL sub forms in the parent – SOLVED
    Private Function ListSubFrms1(frm As Access.Form) As String
    ‘Thanks to Daniel Pineault at https://www.devhut.net/2014/03/13/list-subforms-within-another-form-ms-access-vba/
    ’11 Mar 2020: Made re-iterative to check sub subforms

    Dim sCtrl As String, sFormsList As String
    Dim ctl As Access.Control
    Dim sf As Access.Form

    ‘On Error GoTo Error_Handler

    ‘sFrm = “frmSettings”
    ‘DoCmd.OpenForm sFrm, acDesign
    ‘Set frm = Forms(sFrm).Form
    If frm Is Nothing Then GoTo Error_Handler_Exit
    temp = frm.Name
    For Each ctl In frm.Controls
    Select Case ctl.Properties(“ControlType”)
    Case acSubform ‘, acListBox
    ‘ ctl.Name ‘Will return the given name of the control, not necessarily the actual object name
    ‘ ctl.Properties(“SourceObject”) ‘Will return the object name
    If ctl.Properties(“SourceObject”) = “” Then ‘Never gets here
    Debug.Print ctl.Name
    Else
    sCtrl = ctl.Properties(“SourceObject”)
    ‘Debug.Print sCtrl
    On Error Resume Next
    Set sf = ctl.Form
    If Err.Number = 0 Then
    sFormsList = sFormsList & sCtrl & “;”
    sFormsList = sFormsList & ListSubFrms1(sf)
    Else
    sFormsList = sFormsList & sCtrl & ” – has no subform” & “;”
    End If
    On Error GoTo Error_Handler
    End If
    End Select
    Next ctl

    Error_Handler_Exit:
    On Error Resume Next
    ‘DoCmd.Close acForm, sFrm, acSaveNo
    Set frm = Nothing
    Set sf = Nothing
    Set ctl = Nothing
    ListSubFrms1 = sFormsList
    Exit Function

    Error_Handler:
    MsgBox “The following error has occurred.” & vbCrLf & vbCrLf & _
    “Error Number: ” & Err.Number & vbCrLf & _
    “Error Source: ListSubFrms” & vbCrLf & _
    “Error Description: ” & Err.Description, _
    vbCritical, “An Error has Occurred!”
    Resume Error_Handler_Exit
    End Function
    Private Sub ListSubFrms1_TEST()
    Dim sList As String
    Dim frm As Access.Form
    Const conFrm As String = “frmSettings”
    DoCmd.OpenForm conFrm
    Set frm = Forms(conFrm)
    sList = ListSubFrms1(frm)
    sList = VBA.Replace(sList, “;”, vbCrLf, 2, , vbTextCompare)
    Debug.Print sList
    DoCmd.Close acForm, conFrm, acSaveNo
    Set frm = Nothing
    End Sub

    1. Adrian Price

      I forgot the calling routine for my modification of your routine, ListSubFrms1:

      Private Sub ListSubFrms1_TEST()
      Dim sList As String
      Dim frm As Access.Form
      Const conFrm As String = “frmSettings”
      DoCmd.OpenForm conFrm
      Set frm = Forms(conFrm)
      sList = ListSubFrms1(frm)
      sList = VBA.Replace(sList, “;”, vbCrLf, 2, , vbTextCompare)
      Debug.Print sList
      DoCmd.Close acForm, conFrm, acSaveNo
      Set frm = Nothing
      End Sub