I have the following script which lists loaded forms and the controls sources.
What I would like is to list the loaded forms and there subforms control sources.
What I would like is to list the loaded forms and there subforms control sources.
Code:
Public Sub ListOpenFormControls()
' Read control source property of all controls in all forms.
' Note.. the debug window may not be big enough to display
' all of the data.
Dim db As Database, doc As Document, ctl As Control
Set db = CurrentDb
Dim intX As Integer
Dim SourceName1 As String
'Add Temp Table
'FIELDS WITH SQL'S MUST BE MEMO FIELDS OR NO DATA WILL SHOWN
DoCmd.SetWarnings False
'========================================================================
'Delete Table if exists
Dim dbs As Database
Dim tbl As TableDef
Dim dbsExist As Object
Dim TableName As String
TableName = "zzzTempControlSources" ' Your Table Name
Set dbs = CurrentDb
Set dbsExist = dbs.TableDefs
'--------------------------------------------------------------
' Search for AccessObject objects in AllTables collection.
DoCmd.Close acTable, "zzzTempControlSources"
For Each tbl In dbsExist
If tbl.Name = TableName Then
'MsgBox "Table Exists"
DoCmd.DeleteObject acTable, "zzzTempControlSources"
GoTo CreateT1
End If
Next tbl
CreateT1:
'========================================================================
DoCmd.RunSQL "CREATE TABLE [zzzTempControlSources] ([FormName] TEXT, [ControlName] TEXT, [FormRecordSource] Memo, [ControlSource] Memo, [RowSource] Memo)"
DoCmd.SetWarnings True
DoCmd.SetWarnings True
For Each doc In db.Containers("Forms").Documents
If CurrentProject.AllForms(doc.Name).IsLoaded = True Then
' Form is open
'DoCmd.OpenForm doc.Name, acDesign, , , , acHidden
Dim dbCurrent As DAO.Database
Dim rstWarr As DAO.Recordset
'set the Database and then the table name
Set dbCurrent = CurrentDb
Set rstWarr = dbCurrent.OpenRecordset("zzzTempControlSources") ' table name
'we are adding a record to our table
rstWarr.AddNew
'we add a value to the 1st field of the table which is named FONID
rstWarr("FormName").Value = Forms(doc.Name).Name
SourceName1 = Forms(doc.Name).RecordSource
rstWarr("FormRecordSource").Value = SourceName1
'we now add the data to the table
rstWarr.Update
'Debug.Print doc.Name
On Error Resume Next
For Each ctl In Forms(doc.Name)
'APPEND NEW RECORD
'we are adding a record to our table
rstWarr.AddNew
'we add a value to the 1st field of the table which is named FONID
rstWarr("FormName").Value = doc.Name
rstWarr("ControlName").Value = ctl.Name
rstWarr("Controlsource").Value = ctl.ControlSource
rstWarr("RowSource").Value = ctl.RowSource
'we now add the data to the table
rstWarr.Update
Next
Else
' Form is closed
'MsgBox "oh oh"
End If
'clean up memory
Set dbCurrent = Nothing
Set rstWarr = Nothing
Set dbsExist = Nothing ' Clean up
Next
DoCmd.Close acForm, doc.Name
'=======================================================================
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show <> -1 Then
'MsgBox "No folder selected! Exiting sub...":
Forms!frm_Order_edit.TimerInterval = 0
Exit Sub
End If
mydir = .SelectedItems(1)
End With
'MsgBox mydir
Dim cdb As DAO.Database, qdf As DAO.QueryDef
Set cdb = CurrentDb
Dim filename As String, DateName As String
DateName = Format$(Date, "yyyymmdd")
filename = "List of form control recordsources " & DateName
Dim FILE_PATH As String
FILE_PATH = mydir & "\" ' change this to your file location
Dim strFullPath As String, strFileName As String
strFullPath = FILE_PATH
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "zzzTempControlSources", FILE_PATH & filename, True, "Recordsources"
Set cdb = Nothing
'On Error Resume Next
Workbooks.Open filename & ".xlsx"
DoCmd.OpenForm "GeneralMessageBox"
Forms!GeneralMessageBox.lbCaption.Caption = vbNewLine & "Excel file created - " & strFullPath & filename
End Sub
