[Toutes versions] Rechercher un mot incomplet dans le code SQL des requêtes.

[loufab]

Les modifications d’une application conséquente sont souvent difficiles à réaliser, surtout dans le cas des requêtes. Dans ce billet je vous propose un bout de code pour rechercher un mot, complet ou non, dans toutes les requêtes d’un fichier ACCESS.

Code :

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
Function SnifQuery(Optional strText As String = "")
 On Error GoTo errSub
 
 Dim db As DAO.Database
 Dim qry As DAO.QueryDef
 Set db = CodeDb
 
 ' si rien n'est transmis on demande le mot
 If strText = "" Then
    strText = InputBox("Indiquez le mot à rechercher dans les requêtes." & vbCrLf & _
                 "Ce mot peut être incomplet.", "Mot à rechercher", "")
    If strText = "" Then Exit Function
End If
 
' balaye toutes les requêtes
For Each qry In db.QueryDefs
     'si on trouve le mot
     If qry.sql Like "*" & strText & "*" Then
          ' on ouvre
          DoCmd.OpenQuery qry.Name, acViewDesign
     End If
Next
 
' on est propre donc on ferme le chose dont on ne se sert plus.
Set qry = Nothing
Set db = Nothing
Exit Function
 
errSub:
Resume Next
 
End Function

Pour le lancement vous pouvez passer par la fenêtre Exécution de VBE ou encore créer une macro Autokeys.

• Ouvrez une nouvelle macro.
• Affichez la colonne Nom de macro.
• Entrez le raccourci souhaité. Exemple +^{Q}
• Dans la colonne Action sélectionnez ExécuterCode.
• Indiquez dans le nom de la fonction SnifQuery().

Lorsque vous utiliserez Ctrl+Shift+Q la fonction sera appelée.

Attention ce bout de code ne fait pas de recherche dans les requêtes des bibliothèques.

Cordialement,

[nico84]

Merci ça remplace avantageusement mon petit code qui exporte toutes les requêtes dans un fichier texte

A l'occasion j'ajouterai peut-être l'option "remplace"

Connais-tu la syntaxe pour parcourir aussi les requêtes écrites directement dans les propriétés d'une fenêtre ou d'un champ (me.recordsource ou me.monchamp.rowsource ) ?

[loufab]

Bonjour,

Il faut faire des for each imbriqués.
1 pour les formulaires
--1 pour les contrôles
--- test de la source
----- voir si la source est directe (SELECT) ou bien objet (requête)

Ce ne doit pas être sorcier à faire.

Concernant le remplace, utilise simplement un Replace()

Cordialement,

[nico84]

Envoyé par loufab

Il faut faire des for each imbriqués.
1 pour les formulaires
--1 pour les contrôles
--- test de la source
----- voir si la source est directe (SELECT) ou bien objet (requête)

Ce ne doit pas être sorcier à faire.

Après 1h essais infructueux je confirme que malgré 4 ans de pratique assidue d'access sa logique syntaxique d'adressage de ses objets m'est encore complètement étrangère

Pour être plus précis, dans :

Code :

1
2
3
4
5
6
Dim Fm as Form, Ctl as Control
For Each Fm In CurrentProject.AllForms
  For Each Ctl In Fm.Controls
    If Ctl.ControlType = acComboBox Then If Ctl.RowSource Like "select*" Then msgbox Fm.Name & "." & Ctl.Name & " : " & Ctl.RowSource
  Next
Next

J'ai le message d'erreur "incompatibilité de type" sur le premier For
Par contre le 2e semble OK...

[loufab]

Bonjour,
Il y a effectivement une petite subtilité avec le allforms.

Voici comment il faut rédiger ça :

Code :

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
Function ExplorerForm()
    Dim frm As Object
    Dim vfrm As Form
    Dim ctrl As Control
 
    On Error GoTo err_verif
 
    For Each frm In CurrentProject.AllForms
 
        DoCmd.OpenForm frm.Name, acDesign
        Set vfrm = Forms("[" & frm.Name & "]")
 
        if vfrm.recordsource like "SELECT *" then
           '... ici on traite les propriétés du formulaire
 
        For Each ctrl In vfrm.Controls
            'ici traitement des controles
            if typeof ctrl is combobox or
               typeof ctrl is TextBox or
               typeof ctrl is .. then 
               'traitement des controles qui peuvent avoir la propriété recordsource           
           elseif typeof ctrl is SubForm then
                ' rappel de la même fonction ?   
           endif
 
        Next
 
        DoCmd.Close acForm, frm.Name, acSaveYes
        'DoCmd.Close acForm, frm.Name, acSaveNo
        'End If
    Next
 
    Exit Function
 
err_verif:
    If Err.Number = 438 Then Resume Next
    Debug.Print Err.Number & " " & Err.Description
    Stop
    Resume
 
End Function

Allforms renvoi un objet mais pour parcourir il faut un form. On instancie donc le form une fois celui-ci ouvert.
On peut très bien mettre des Echo false/true pour cacher la tambouille.

Pour les états c'est la même chose à part quelques type de variables à changer ainsi que les 2 commandes open et close.
Cordialement,

[nico84]

Bonsoir et merci, effectivement je pouvais chercher longtemps !!!

Avec tout ça il va être possible de faire une recherche vraiment exhaustive

[loufab]

N'hésite pas à nous faire part de ton code...

[nico84]

Bonjour,

J'ai trouvé le temps de finir une première version que chacun pourra adapter selon ses besoins

Code :

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

NB : ma gestion d'erreur nécessite le numérotage des lignes et une fonction "message" qui affiche à l'écran et écrit dans un journal. Comme son nom l'indique le mode_debug est réservé au développeur...

[loufab]

Je vote +1 !