'---------------------------------------------------------------------------------------
' Procedure : FindSources
' DateTime : 2006-04-26 20:02
' Author :
' Purpose : From TekTips - people trying
' to find table usage in Access Objects
'
' Procedure is a slight modification to the
' FindSources by MichaelRed
' @ 26 Apr 06 19:50
'
' This function requires a table
' name: tblObjDefs
'
' columns:
' objName text(50)
' objType text(50)
' objSource memo
'
'
' ** This proc will create the table and Index **
'
'Sub CreateTheTable()
'DoCmd.RunSQL ("CREATE TABLE tblObjDefs " _
' & " ( objName text(50), " _
' & " objType text(50), " _
' & " objSource memo, " _
' & " CONSTRAINT MyKeyZ " _
' & " PRIMARY KEY (objName, objType) );")
'End Sub
'
'
'
'---------------------------------------------------------------------------------------
'
Public Function FindSources()
'******* SECTION NOTE ******* _
Define all the variables used only in this procedure. _
Dim dbs As Database
Dim rst As Recordset
Dim Cntnr As Container
Dim Doc As Document
Dim qdf As QueryDef
Dim frm As Form
Dim rpt As Report
Dim tdf As TableDef
Dim strResp As String
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tblObjDefs")
'Clear previous
DoCmd.SetWarnings False
DoCmd.RunSQL "Delete * from tblObjDefs;"
DoCmd.SetWarnings True
With rst
'******************** SECTION NOTE ****************** _
Collect the SQL for each query object in the database _
For Each qdf In dbs.QueryDefs
.AddNew
!objName = qdf.Name
!objSource = qdf.sql
'=======> ' !ObjType = basQueryType(qdf.Type) & " Query"
' *******************************************
' ** Identify Query ObjTypes **
' *******************************************
!objType = "Query -" _
& IIf(qdf.Type = 0, "SELECT", ( _
IIf(qdf.Type = 32, "DELETE", ( _
IIf(qdf.Type = 48, "UPDATE", ( _
IIf(qdf.Type = 64, "APPEND", ( _
IIf(qdf.Type = 80, "MK TBL", qdf.Type)))))))))
.Update
Next
'********************* SECTION NOTE ******************** _
Collect the source for each form object _
Set Cntnr = dbs.Containers("Forms")
For Each Doc In Cntnr.Documents
.AddNew
!objName = Doc.Name
DoCmd.OpenForm Doc.Name, acDesign, , , , acHidden
Set frm = Forms(Doc.Name)
!objSource = frm.RecordSource
DoCmd.Close acForm, Doc.Name
!objType = "Form"
.Update
Next
'********************** SECTION NOTE ******************* _
Collect the source for each report object _
Set Cntnr = dbs.Containers("Reports")
For Each Doc In Cntnr.Documents
.AddNew
!objName = Doc.Name
'=====> DoCmd.OpenReport Doc.Name, acViewDesign , , , acHidden
DoCmd.OpenReport Doc.Name, acViewDesign ', , , acHidden
Set rpt = Reports(Doc.Name)
!objSource = rpt.RecordSource
!objType = "Report"
.Update
DoCmd.Close acReport, Doc.Name '<===close report
Next
'******************** SECTION NOTE ******************** _
Collect the Name of each tabledef object. _
'*** I did not see the following implemented *** _
Do not include the two tables used in this utility _
"~TableObjects" and "~ObjectSources". _
Dim tdfloop As TableDef
For Each tdfloop In dbs.TableDefs
If (Left(tdfloop.Name, 4) <> "MSys") Then
.AddNew
!objName = tdfloop.Name
!objType = "Table"
.Update
End If
Next tdfloop
End With
'************************ SECTION NOTE ***************** _
Clean up the variables that were used to release the memory space.
Set dbs = Nothing
Set rst = Nothing
End Function