Determine which tables are no longer used

[arnelgp]

added code to check it the table is a Lookup for a field in another table:

' 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