1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94
| Public Sub SnifQuery(optional av as string = "" ,optional ap as string = "")
If Not Mode_debug Then On Error GoTo err:
Dim Qry As DAO.QueryDef, i1 As Integer, i2 As Integer, i3 As Integer
Dim FSO As New Scripting.FileSystemObject, F1 As Scripting.TextStream
Dim av As String, ap As String
Dim oFm As Object, Fm As Form, Ctl As Control
'si rien n'est transmis on demande les mots
100 If av = "" Then
102 av = InputBox("Indiquez le mot à rechercher dans les requêtes.", "Mot à rechercher", "")
104 If av = "" Then Exit Sub
End If
106 If ap = "" Then ap = InputBox("Indiquez par quoi le remplacer." & vbCr & "(recherche simple si vide)", "remplacement", "")
'petit controle pour éviter une boucle infinie
108 If ap > "" Then If ap Like "*" & av & "*" Then MsgBox "La chaine remplaçante ne peut pas contenir la chaine remplacée.": Exit Sub
'crée un fichier texte de compte-rendu
110 Set F1 = FSO.OpenTextFile(Planet_path & "Rq" & Format(Date, "yymmdd") & ".txt", ForWriting, True)
112 i1 = 0: i2 = 0: i3 = 0 'compteurs d'occurences et de remplacements
'balaye toutes les requêtes et remplace ou édite si présent
120 For Each Qry In CurrentDb.QueryDefs
122 If Left(Qry.Name, 1) <> "~" And Qry.Sql Like "*" & av & "*" Then 'les requêtes sytème commencent par ~
124 i1 = i1 + 1
126 If ap > "" Then
128 If MsgBox("Remplacer " & av & " par " & ap & " dans " & Qry.Name & " ?", vbYesNo, "Confirmation") = vbYes Then
130 i3 = 0
132 While Qry.Sql Like "*" & av & "*": Qry.Sql = Replace(Qry.Sql, av, ap, 1, 1): i3 = i3 + 1: Wend
134 i2 = i2 + i3
136 F1.WriteLine i3 & " remplacement(s) de " & av & " par " & ap & " dans " & Qry.Name
Else
'138 DoCmd.OpenQuery qry.Name, acViewDesign
138 F1.WriteLine av & " a été trouvé sans remplacement dans la requete " & Qry.Name
End If
Else
140 F1.WriteLine av & " a été trouvé dans la requete " & Qry.Name
End If: End If
Next
142 Set Qry = Nothing
'balaye les formulaires, les controles et les propriétés
200 For Each oFm In CurrentProject.AllForms
202 DoCmd.OpenForm oFm.Name, acDesign
204 Set Fm = Forms("[" & oFm.Name & "]")
'source du formulaire
220 If Fm.RecordSource Like "SELECT*" & av & "*" Then
224 i1 = i1 + 1
226 If ap > "" Then
228 If MsgBox("Remplacer " & av & " par " & ap & " dans la source de " & oFm.Name & " ?", vbYesNo, "Confirmation") = vbYes Then
230 i3 = 0
232 While Fm.RecordSource Like "*" & av & "*": Fm.RecordSource = Replace(Fm.RecordSource, av, ap, 1, 1): i3 = i3 + 1: Wend
234 i2 = i2 + i3
236 F1.WriteLine i3 & " remplacement(s) de " & av & " par " & ap & " dans la source de " & oFm.Name
Else
238 F1.WriteLine av & " a été trouvé sans remplacement dans la source de " & oFm.Name
End If
Else
240 F1.WriteLine av & " a été trouvé dans la source de " & oFm.Name
End If: End If
'source des controles du formulaire - pour l'instant je ne traite que les combobox...
300 For Each Ctl In Fm.Controls
302 If Ctl.ControlType = acComboBox Then 'variante : If TypeOf Ctl Is ComboBox
304 If Ctl.RowSource Like "SELECT*" & av & "*" Then
324 i1 = i1 + 1
326 If ap > "" Then
328 If MsgBox("Remplacer " & av & " par " & ap & " dans la source de " & oFm.Name & "." & Ctl.Name & " ?", vbYesNo, "Confirmation") = vbYes Then
330 i3 = 0
332 While Ctl.RowSource Like "*" & av & "*": Ctl.RowSource = Replace(Ctl.RowSource, av, ap, 1, 1): i3 = i3 + 1: Wend
334 i2 = i2 + i3
336 F1.WriteLine i3 & " remplacement(s) de " & av & " par " & ap & " dans la source de " & oFm.Name & "." & Ctl.Name
Else
338 F1.WriteLine av & " a été trouvé sans remplacement dans la source de " & oFm.Name & "." & Ctl.Name
End If
Else
340 F1.WriteLine av & " a été trouvé dans la source de " & oFm.Name & "." & Ctl.Name
End If: End If
'350 ElseIf TypeOf Ctl Is TextBox Then
'360 ElseIf TypeOf Ctl Is SubForm Then
End If
Next
380 DoCmd.Close acForm, oFm.Name, acSaveYes
Next
382 Set Ctl = Nothing
384 Set Fm = Nothing
386 Set oFm = Nothing
390 F1.WriteLine av & " a été trouvé dans " & i1 & " requête(s)" & IIf(i2 > 0, " et remplacé " & i2 & " fois.", ".")
392 Shell "notepad.exe " & Planet_path & "Rq" & Format(Date, "yymmdd") & ".txt", vbMaximizedFocus
Exit Sub
err: Call message("Erreur " & err.Number & "/" & Erl & " dans fonctions.snifquery : " & err.description)
End Sub |
Partager