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
|