arnelgp
..forever waiting... waiting for jellybean!
- Local time
- Tomorrow, 05:06
- Joined
- May 7, 2009
- Messages
- 19,839
added code to check it the table is a Lookup for a field in another table:
Code:
' chatgpt
'
Sub CheckUnusedTables()
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim qdf As DAO.QueryDef
Dim doc As AccessObject
Dim frm As Form
Dim rpt As Report
Dim TableName As String
Dim tableUsed As Boolean
Dim i As Integer
Set db = CurrentDb()
' Loop through each table in the database
For Each tdf In db.TableDefs
If Not (tdf.Name Like "MSys*" Or tdf.Name Like "~*") Then ' Ignore system and temporary tables
TableName = tdf.Name
tableUsed = False
' Check queries for table usage
For Each qdf In db.QueryDefs
If InStr(1, qdf.SQL, TableName, vbTextCompare) > 0 Then
tableUsed = True
Exit For
End If
Next qdf
' Check forms for table usage
If Not tableUsed Then
For Each doc In CurrentProject.AllForms
DoCmd.OpenForm doc.Name, acDesign, , , , acHidden
Set frm = Forms(doc.Name)
For i = 0 To frm.RecordSource Like "*" & TableName & "*"
If InStr(1, frm.RecordSource, TableName, vbTextCompare) > 0 Then
tableUsed = True
Exit For
End If
Next i
DoCmd.Close acForm, doc.Name
If tableUsed Then Exit For
Next doc
End If
' Check reports for table usage
If Not tableUsed Then
For Each doc In CurrentProject.AllReports
DoCmd.OpenReport doc.Name, acDesign, , , acHidden
Set rpt = Reports(doc.Name)
If InStr(1, rpt.RecordSource, TableName, vbTextCompare) > 0 Then
tableUsed = True
Exit For
End If
DoCmd.Close acReport, doc.Name
If tableUsed Then Exit For
Next doc
End If
' check modules and class
If Not tableUsed Then
tableUsed = CheckTableReference(TableName)
End If
' check macros
If Not tableUsed Then
tableUsed = CheckTableInMacros(TableName)
End If
'arnelgp
'check if it is a Lookup for another table
If Not tableUsed Then
tableUsed = IsLookup(TableName)
End If
' Print unused table name
If Not tableUsed Then
Debug.Print "Unused Table: " & TableName
End If
End If
Next tdf
' Clean up
Set tdf = Nothing
Set qdf = Nothing
Set db = Nothing
End Sub
'another from chatgpt
'check all modules, classes
Function CheckTableReference(ByVal TableName As String) As Boolean
Dim vbProj As VBIDE.VBProject
Dim vbComp As VBIDE.VBComponent
Dim codeMod As VBIDE.CodeModule
Dim lineNum As Long
Dim numLines As Long
Dim codeLine As String
'Dim tableName As String
Dim isFound As Boolean
' Set the name of the table you are looking for
'tableName = "YourTableName"
isFound = False
' Set the current VBA project
Set vbProj = Application.VBE.VBProjects(1) ' Assuming you have only one project open
' Loop through all modules
For Each vbComp In vbProj.VBComponents
' Check if the component has a code module
If vbComp.Type = vbext_ct_StdModule Or vbComp.Type = vbext_ct_ClassModule Or vbComp.Type = vbext_ct_Document Then
Set codeMod = vbComp.CodeModule
numLines = codeMod.CountOfLines
' Loop through each line of code
For lineNum = 1 To numLines
codeLine = codeMod.Lines(lineNum, 1)
' Check if the table name is referenced in the line
If InStr(1, codeLine, TableName, vbTextCompare) > 0 Then
'Debug.Print "Table '" & tableName & "' found in Module: " & vbComp.Name & " at line " & lineNum
isFound = True
End If
Next lineNum
End If
Next vbComp
' Notify if the table reference was not found
'If Not isFound Then
' MsgBox "Table '" & tableName & "' was not found in any module.", vbInformation
'Else
' MsgBox "Search completed. Check the Immediate window for details.", vbInformation
'End If
CheckTableReference = isFound
End Function
' again from chatgpt
' check macros
'
Function CheckTableInMacros(ByVal TableName As String) As Boolean
Dim macroObj As AccessObject
Dim found As Boolean
Dim db As Object
Dim tmpFile As String
Dim content As String
tmpFile = Environ$("temp") & "\TmpMcr.txt"
Set db = CurrentProject
found = False
' Loop through all macros in the database
For Each macroObj In db.AllMacros
'arnelgp
'save macro to disk
Application.SaveAsText acMacro, macroObj.Name, tmpFile
'read the content
content = ReadTextFile(tmpFile)
found = InStr(1, content, TableName)
If found Then Exit For
Next macroObj
'If Not found Then
' Debug.Print "Table '" & tableName & "' was not found in any macros."
'End If
Set db = Nothing
CheckTableInMacros = found
End Function
' chatgpt
Function ReadTextFile(ByVal filePath As String) As String
Dim fileNumber As Integer
Dim fileContent As String
Dim line As String
' Get a free file number
fileNumber = FreeFile
' Open the file for input
Open filePath For Input As #fileNumber
' Read the file line by line
Do While Not EOF(fileNumber)
Line Input #fileNumber, line
fileContent = fileContent & line & vbCrLf
Loop
' Close the file
Close #fileNumber
' Print the content to the Immediate Window (Debug Window)
'Debug.Print fileContent
ReadTextFile = fileContent
End Function
'arnelgp
Function IsLookup(ByVal SourceTable As String) As Boolean
Dim db As DAO.Database
Dim tdf As TableDef
Dim fld As Field
Dim TableName As String
Dim prp As Property
Set db = CurrentDb
For Each tdf In db.TableDefs
TableName = tdf.Name
If (TableName Like "MSys*" Or TableName Like "~*" Or TableName = SourceTable) Then ' Ignore system and temporary tables
Else
On Error Resume Next
For Each fld In tdf.Fields
Set prp = fld.Properties("RowSource")
If Not (prp Is Nothing) Then
IsLookup = (InStr(1, prp.Value, SourceTable) <> 0)
Exit For
End If
Err.Clear
Next fld
End If
Err.Clear
On Error GoTo 0
If IsLookup Then
Exit For
End If
Next tdf
Set fld = Nothing
Set tdf = Nothing
Set db = Nothing
End Function
