Rocky Smolin
rockysmolin at bchacc.com
Mon Mar 26 22:41:15 CDT 2012
I'd use Rick Fisher's Find and Replace for that. It will check every form,
report, query, table, and module.
Rocky Smolin
Beach Access Software
858-259-4334
www.bchacc.com
www.e-z-mrp.com
Skype: rocky.smolin
-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Benson, William
(GE Global Research, consultant)
Sent: Monday, March 26, 2012 8:34 PM
To: Access Developers discussion and problem solving
Subject: [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 t!
hen 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
--
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com