General

6.51 Verifica se una tabella o una query è usata in una form o in un report.
  Lorenzo Coronati, Davide La Mantia (Sib)
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
    On Error GoTo annulla
    Dim ro As Recordset
    Dim f As Variant
    Dim m As Module
    Dim qdf As QueryDef
    Dim str As String
    Dim intL As Integer
    Dim intP As Integer
    'Dim intMas As Integer 'Serve per riaprire le maschere
    'Dim strMasAp() As String 'Serve per riaprire le maschere
    Segugio = False
    Set ro = CurrentDb.OpenRecordset("SELECT Name, Type FROM MSysObjects WHERE Flags = 0 OR Flags = 8;", dbOpenSnapshot)
    ro.MoveFirst
    DoCmd.Echo False
    DoCmd.SetWarnings False
    'intMas = MaschereAperte(strMasAp) 'Serve per riaprire le maschere
    Do Until ro.EOF
        Select Case ro!Type
            Case -32768 'form
                DoCmd.OpenForm ro!name, acDesign, , , , acHidden
                Set f = Forms(ro!name)
                If TrovaStringa(Nome, f.RecordSource) Or TrovaDentro(Nome, Forms(ro!name)) Then
                    Segugio = True
                    If dettagli Then Debug.Print "Form " & ro!name & vbCr; Else GoTo esci
                End If
                If f.HasModule Then
                    Set m = f.Module
                    If TrovaNelModulo(m, Nome) Then
                        Segugio = True
                        If dettagli Then Debug.Print "Modulo di classe della form " & ro!name & vbCr; Else GoTo esci
                    End If
                End If
                DoCmd.Close acForm, ro!name, acSaveNo
            Case -32764 'report
                DoCmd.OpenReport ro!name, acViewDesign
                Set f = Reports(ro!name)
                If TrovaStringa(Nome, f.RecordSource) Then
                    Segugio = True
                    If dettagli Then Debug.Print "Report " & ro!name & vbCr; Else GoTo esci
                End If
                If f.HasModule Then
                    Set m = f.Module
                    If TrovaNelModulo(m, Nome) Then
                        Segugio = True
                        If dettagli Then Debug.Print "Modulo di classe del Report " & ro!name & vbCr; Else GoTo esci
                    End If
                End If
                DoCmd.Close acReport, ro!name, acSaveNo
            Case -32761 'moduli
                DoCmd.OpenModule ro!name
                Set m = Modules(ro!name)
                If TrovaNelModulo(m, Nome) Then
                    Segugio = True
                    If dettagli Then Debug.Print "Modulo " & ro!name & vbCr; Else GoTo esci
                End If
                DoCmd.Close acModule, ro!name, acSaveNo
            Case 5 'query
                Set qdf = CurrentDb.QueryDefs(ro!name)
                intP = InStr(1, qdf.SQL, "FROM", vbTextCompare) + 5
                If InStr(1, qdf.SQL, "WHERE", vbTextCompare) > 0 Then
                    intL = InStr(1, qdf.SQL, "WHERE", vbTextCompare) - (InStr(1, qdf.SQL, "FROM", vbTextCompare) + 5)
                Else
                    intL = Len(qdf.SQL) - (InStr(1, qdf.SQL, "FROM", vbTextCompare) + 5)
                End If
                str = Mid(qdf.SQL, intP, intL)
                If TrovaStringa(Nome, str) Then
                    Segugio = True
                    If dettagli Then Debug.Print "Query " & ro!name & vbCr; Else GoTo esci
                End If
            Case Else
        End Select
        ro.MoveNext
    Loop

esci:
    DoCmd.Echo True
    DoCmd.SetWarnings True
    Set ro = Nothing
    Set f = Nothing
    Set m = Nothing
    Set qdf = Nothing
    '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
        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


Se pensate di avere del materiale freeware interessante e volete pubblicarlo, allora leggete qui.