Public Function Segugio(Nome As String, Optional dettagli As Boolean) As
Boolean
    'Autori: Sib e LoreCoro
    'serve per verificare se una query o tabella e' usata in una form o in
un Report
    'se si imposta dettagli a true, vengono elencati form e report
contenenti la stringa
    'Versione rivista e corretta per progetti access (APD)
    'Bisogna attivare i riferimenti ADODB e ADOX (ADO Ext)
    On Error GoTo annulla
    Dim iForm As Integer
    Dim fVedi As Boolean
    'Dim intMas As Integer 'Serve per riaprire le maschere
    'Dim strMasAp() As String 'Serve per riaprire le maschere
    fVedi = False
    DoCmd.Echo False
    DoCmd.SetWarnings False
    'intMas = MaschereAperte(strMasAp) 'Serve per riaprire le maschere
    For iForm = 0 To CurrentProject.AllForms.Count - 1
        fVedi = Analizza(CurrentProject.AllForms(iForm).name, "Forms", Nome,
dettagli)
        If fVedi Then Segugio = True
    Next iForm
    For iForm = 0 To CurrentProject.AllReports.Count - 1
        fVedi = Analizza(CurrentProject.AllReports(iForm).name, "Reports",
Nome, dettagli)
        If fVedi Then Segugio = True
    Next iForm
    For iForm = 0 To CurrentProject.AllMacros.Count - 1
        fVedi = Analizza(CurrentProject.AllMacros(iForm).name, "Macros",
Nome, dettagli)
        If fVedi Then Segugio = True
    Next iForm
    For iForm = 0 To CurrentProject.AllModules.Count - 1
        fVedi = Analizza(CurrentProject.AllModules(iForm).name, "Modules",
Nome, dettagli)
        If fVedi Then Segugio = True
    Next iForm
    For iForm = 0 To CurrentProject.AllDataAccessPages.Count - 1
        fVedi = Analizza(CurrentProject.AllDataAccessPages(iForm).name,
"DataAccessPages", Nome, dettagli)
        If fVedi Then Segugio = True
    Next iForm
    Dim rst As ADODB.Recordset
    Set rst = CurrentProject.Connection.OpenSchema(adSchemaTables)
    Do Until rst.EOF
        If (rst!table_type <> "SYSTEM TABLE") And (rst!table_type <> "SYSTEM
VIEW") And (rst!table_type <> "TABLE") Then
            fVedi = Analizza(rst!table_name, rst!table_type, Nome, dettagli)
            If fVedi Then Segugio = True
        End If
        rst.MoveNext
    Loop

Esci:
    DoCmd.Echo True
    DoCmd.SetWarnings True
    'Serve per riaprire le maschere
    'If intMas > 0 Then
    '    For intL = 1 To intMas
    '        DoCmd.OpenForm strMasAp(intL, 1), , , strMasAp(intL, 2)
    '    Next
    'End If
    Exit Function
annulla:
    MsgBox "Si è verificato un errore (" & Err.Number & ")" &
Error(Err.Number), vbCritical + vbOKOnly, "Errore"
    Resume Esci
End Function

Public Function TrovaStringa(parte As String, stringa As String) As Boolean
    TrovaStringa = InStr(1, stringa, parte)
End Function

Public Function MaschereAperte(str() As String) As Integer
    'Serve per riaprire le maschere
    Dim fm As Form
    MaschereAperte = 0
    ReDim str(Forms.Count, 2)
    For Each fm In Forms
        MaschereAperte = MaschereAperte + 1
        str(MaschereAperte, 1) = fm.name
        str(MaschereAperte, 2) = fm.Filter
    Next fm
End Function

Public Function TrovaDentro(Nome As String, f As Form) As Boolean
    Dim ctl As Control
    TrovaDentro = False
    For Each ctl In f
        If ctl.ControlType = acListBox Or ctl.ControlType = acComboBox Then
            If ctl.RowSourceType = "Table/query" Then TrovaDentro =
TrovaStringa(Nome, ctl.RowSource) Or TrovaDentro
            TrovaDentro = TrovaStringa(Nome, ctl.ControlSource) Or
TrovaDentro
        End If
    Next ctl
End Function

Public Function TrovaNelModulo(m As Module, s As String) As Boolean
    'ricerca la stringa s nel modulo m
    On Error GoTo annulla
    Dim ri As Long, ci As Long, rf As Long, CF As Long
    Dim strSinistra As String, strDestra As String
    TrovaNelModulo = m.Find(s, ri, ci, rf, CF)
Esci:
    Exit Function
annulla:
    'MsgBox Err & ": " & Err.Description
    TrovaNelModulo = False
    Resume Esci
End Function


Private Function Analizza(stNome As String, stTipo As String, Nome As
String, dettagli As Boolean) As Boolean
    Dim f As Variant
    Dim m As Module
    Dim str As String
    Dim intL As Integer
    Dim intP As Integer
    Dim Transit As Boolean
        Select Case stTipo
            Case "Forms"
                DoCmd.OpenForm stNome, acDesign, , , , acHidden
                Set f = Forms(stNome)
                If TrovaStringa(Nome, f.RecordSource) Or TrovaDentro(Nome,
Forms(stNome)) Then
                    Analizza = True
                    If dettagli Then Debug.Print "Form " & stNome & vbCr;
Else GoTo Esci
                End If
                If f.HasModule Then
                    Set m = f.Module
                    If TrovaNelModulo(m, Nome) Then
                        Analizza = True
                        If dettagli Then Debug.Print "Modulo di classe della
form " & stNome & vbCr; Else GoTo Esci
                    End If
                End If
                DoCmd.Close acForm, stNome, acSaveNo
            Case "Reports"
                DoCmd.OpenReport stNome, acViewDesign
                Set f = Reports(stNome)
                If TrovaStringa(Nome, f.RecordSource) Then
                    Analizza = True
                    If dettagli Then Debug.Print "Report " & stNome & vbCr;
Else GoTo Esci
                End If
                If f.HasModule Then
                    Set m = f.Module
                    If TrovaNelModulo(m, Nome) Then
                        Analizza = True
                        If dettagli Then Debug.Print "Modulo di classe del
Report " & stNome & vbCr; Else GoTo Esci
                    End If
                End If
                DoCmd.Close acReport, stNome, acSaveNo
            Case "Modules"
                On Error GoTo ErrModChiuso:
                Set m = Modules(stNome)
                Transit = False
Riprendi:
                If Transit Then DoCmd.OpenModule stNome
                Set m = Modules(stNome)
                If TrovaNelModulo(m, Nome) Then
                    Analizza = True
                    If dettagli Then Debug.Print "Modulo " & stNome & vbCr;
Else GoTo Esci
                End If
                If Transit Then DoCmd.Close acModule, stNome, acSaveNo
                On Error GoTo 0
            Case "Macros"
                'Qualcosa che abbia a che fare con le macro
                If TrovaStringa(Nome, str) Then
                    Analizza = True
                    If dettagli Then Debug.Print "Query " & stNome & vbCr;
Else GoTo Esci
                End If
            Case "VIEW"
                Dim vis As ADOX.View

            Case Else
        End Select
Esci:
    Set f = Nothing
    Set m = Nothing
    Exit Function
ErrModChiuso:
    If Err.Number = 7961 Then
        Transit = True
        Resume Riprendi
    End If
End Function