[AccessD] Judging whether a table is "used"

Does anyone have the "definitive" code for testing whether a name of a non-field object is "used" ANYWHERE in a database? I have some code which I am about to post and it is so long I am not even sure that it isn't redundant. I have no idea where I originally got it. It does the basics likes looks through query names and sql, macros, vb modules, formnames, control sources on form controls, recordsources on form controls, sourceobjects on subforms on forms. Lately I even discovered it is worthwhile to check if a field in some table has a rowsource property, which might lookup values in some table with the name being searched for. I only match a substring, so of course I get some false positives. My goal is not to delete a table which might be used in any fashion in my database without checking the object that refers to it. I am thinking *maybe* if I ran the database documenter with every conceivable option set, and pumped that to word, I might have a reference document; but then I have to use that complex procedure every time I have made a change in the database, if I want to be sure -- as opposed to running some code. I would hope there is some commercial add-in or tool which could do this for me, and I would certainly pay $50 or more for a tool I could rely on which is more comprehensive than my code -- which I am sure has many gaps and doesn't even check reports and needs a reference to VBA Extensibility.


Function checkSQL(Optional strSearch, Optional SkipMsg) As String
Dim D As DAO.Database
Dim k As Long
Dim Q As DAO.QueryDef
Dim Fld As DAO.Field
Dim T As DAO.TableDef
Dim Prp As DAO.Property
Dim MyText As String
Dim FirstOne As String
Dim i As Long
Dim oVBE As VBIDE.VBE
Dim oVP As VBIDE.VBProject
Dim oCM As VBIDE.CodeModule
Dim oVC As VBIDE.VBComponent
Dim ctr As DAO.Container
Dim Doc As DAO.Document
Dim frm As Form
Dim Ctrl As Control
Dim Ar() As String
Dim F As DAO.Field
Dim FS, Txt As TextStream, str As String
ReDim Ar(0)
Dim bInFields As Boolean

''''outputs to a msgbox (obviously will be incomplete if a long result) as well as to the 
''''immediate window (which could also end up being incomplete if something occurs hundreds of times... such as the letter "t"  :-)
If IsMissing(strSearch) Then
  MyText = InputBox("Paste Query or Table Name here")
ElseIf CStr(strSearch) <> "" Then
  MyText = strSearch
Else
  MyText = InputBox("Paste Query or Table Name here")
End If
If UCase(MyText) = "" Then Exit Function

Set D = CurrentDb
CheckQueries:

For Each Q In D.QueryDefs
  If Left(Q.Name, 1) <> "~" Then
    bInFields = False
    If InStr(UCase(Q.Name), UCase(MyText)) > 0 Then
      ReDim Preserve Ar(UBound(Ar) + 1)
      Ar(UBound(Ar)) = "Query: " & Q.Name
    End If
    If Q.Connect = "" Then
      For i = 1 To Q.Fields.Count
        If InStr(UCase(Q.Fields(i - 1).Name), UCase(MyText)) > 0 Then
          bInFields = True
          ReDim Preserve Ar(UBound(Ar) + 1)
          Ar(UBound(Ar)) = "Query: " & Q.Name & "  Field: " & Q.Fields(i - 1).Name
        End If
      Next
      If Not bInFields Then
        If InStr(UCase(Q.SQL), UCase(MyText)) > 0 And Left(Q.Name, 1) <> "~" Then
          ReDim Preserve Ar(UBound(Ar) + 1)
          Ar(UBound(Ar)) = "Query: " & Q.Name
        End If
      End If
    End If
  End If
Next
  
CheckTables:
For Each T In D.TableDefs
  If Left(T.Name, 1) <> "~" Then
    If InStr(UCase(T.Name), UCase(MyText)) > 0 Then
      ReDim Preserve Ar(UBound(Ar) + 1)
      Ar(UBound(Ar)) = "Table: " & T.Name
    End If
    For i = 1 To T.Fields.Count
      If InStr(UCase(T.Fields(i - 1).Name), UCase(MyText)) > 0 Then
        ReDim Preserve Ar(UBound(Ar) + 1)
        Ar(UBound(Ar)) = "Table: " & T.Name & "  Field: " & T.Fields(i - 1).Name
      End If
    Next
    
    For i = 1 To T.Fields.Count
      Set Fld = T.Fields(i - 1)
      For Each Prp In Fld.Properties
        If Prp.Name = "Rowsource" Then
          If InStr(UCase(Prp.Value), UCase(MyText)) > 0 Then
            ReDim Preserve Ar(UBound(Ar) + 1)
            Ar(UBound(Ar)) = "Table: " & T.Name & "  Has field: " & Fld.Name & " which looks up values in " & Prp.Value & "."
          End If
        End If
      Next
    Next
    
  End If
Next

i = 0
k = 0
Set oVBE = Application.VBE
Set oVP = oVBE.ActiveVBProject
For Each oVC In oVP.VBComponents
  Set oCM = oVC.CodeModule
  If InStr(UCase(oCM.Lines(1, oCM.CountOfLines)), UCase(MyText)) > 0 Then
    ReDim Preserve Ar(UBound(Ar) + 1)
    Ar(UBound(Ar)) = "Module: " & oVC.Name
    GoTo NextModule
  End If
NextModule:
k = k + 1
Next
For Each ctr In D.Containers
  If ctr.Name = "Forms" Then
    For Each Doc In ctr.Documents
      DoCmd.OpenForm Doc.Name, acDesign
      Set frm = Forms(Doc.Name)
      If InStr(UCase(frm.RecordSource), UCase(MyText)) > 0 Then
        ReDim Preserve Ar(UBound(Ar) + 1)
        Ar(UBound(Ar)) = "Form: " & frm.Name & " RecordSource: " & frm.RecordSource
      End If
      For Each Ctrl In frm.Controls
        'If Ctrl.Name = "SubfrmSite" Then Stop
      On Error Resume Next
        If InStr(UCase(Ctrl.ControlSource), UCase(MyText)) > 0 Then
          If Err.Number = 0 Then
            ReDim Preserve Ar(UBound(Ar) + 1)
            Ar(UBound(Ar)) = "Form: " & frm.Name & " ControlType: " & TypeName(Ctrl) & " ControlName: " & Ctrl.Name
          ElseIf TypeName(Ctrl) = "SubForm" Then
            If InStr(Nz(UCase(Ctrl.SourceObject), ""), UCase(MyText)) > 0 Then
              ReDim Preserve Ar(UBound(Ar) + 1)
              Ar(UBound(Ar)) = "Form: " & frm.Name & " Control: " & Ctrl.Name & " (a subform) SourceObject: " & Ctrl.SourceObject
            Else
'              Err.Clear
'              If InStr(UCase(Ctrl.Form.RecordSource), UCase(MyText)) > 0 Then
'              If Err.Number = 0 Then
'              ReDim Preserve Ar(UBound(Ar) + 1)
'              Ar(UBound(Ar)) = "Form: " & frm.Name & " Control: " & Ctrl.Name & " (a subform) RecordSource: " & Ctrl.Form.SourceObject
'              End If
'              End If
            End If
          End If
          Err.Clear
        End If
        If InStr(UCase(Ctrl.Name), UCase(MyText)) > 0 Then
          If Err.Number = 0 Then
            ReDim Preserve Ar(UBound(Ar) + 1)
            Ar(UBound(Ar)) = "Form: " & frm.Name & " ControlType: " & TypeName(Ctrl) & " ControlName: " & Ctrl.Name
          End If
          Err.Clear
        End If
        If InStr(UCase(Ctrl.RowSource), UCase(MyText)) > 0 Then
          If Err.Number = 0 Then
            ReDim Preserve Ar(UBound(Ar) + 1)
            Ar(UBound(Ar)) = "Form: " & frm.Name & " ControlType: " & TypeName(Ctrl) & " ControlName: " & Ctrl.Name
          End If
          Err.Clear
        End If
      Next
      DoCmd.Close acForm, Doc.Name
    Next Doc
  End If
  If ctr.Name = "Scripts" Then
    For Each Doc In ctr.Documents
      If InStr(UCase(Doc.Name), UCase(MyText)) > 0 Then
        ReDim Preserve Ar(UBound(Ar) + 1)
        Ar(UBound(Ar)) = "Macro: " & Doc.Name
      End If
      Kill Environ("temp") & "\TempFileMacroName.txt"
      Application.SaveAsText acMacro, Doc.Name, Environ("temp") & "\TempFileMacroName.txt"
      Set FS = New FileSystemObject 'CreateObject("Scripting.FileSystemObject")
      Set Txt = FS.OpenTextFile(Environ("temp") & "\TempFileMacroName.txt")
      str = Txt.ReadAll
      Set Txt = Nothing
      If InStr(UCase(str), UCase(MyText)) > 0 Then
        ReDim Preserve Ar(UBound(Ar) + 1)
        Ar(UBound(Ar)) = "Macro: " & Doc.Name
      End If
      Kill Environ("temp") & "\TempFileMacroName"
    Next
  End If
Next ctr
str = ""
For i = 1 To UBound(Ar)
  str = str & IIf(str = "", "", Chr(13)) & Ar(i)
  Debug.Print Ar(i)
Next

checkSQL = str
If IsMissing(SkipMsg) Then
  MsgBox checkSQL
End If

End Function