[Sources] VBA ouvrir Recordset (ADO/DAO) sur requête paramétrée basée sur formulaires

**=JBO=** · 22/05/2009, 14h36

Bonjour,

Je me décide à ajouter dans les contributions une réponse à une question récurrente sur le forum.

Vous avez développé des requêtes Access qui font directement référence à des contrôles de formulaire.
Tout fonctionne au mieux. C'est génial !

Puis ensuite, avec VBA, vous voulez exploiter directement un jeu d'enregistrements (Recordset ADO ou DAO) basé sur une de ces requêtes.
Mais voilà, la tentative d'ouverture d'un Recordset déclenche une erreur d'exécution...
• avec DAO, erreur 3061: "Trop peu de paramètres. <n> attendu."
• avec ADO, erreur -2147217904 (80040e10): "Aucune valeur donnée pour un ou plusieurs des paramètres requis."

C'est normal.
Le problème est que, si Access sait évaluer une requête comportant des expressions qui désignent un contrôle de formulaire, en revanche DAO/ADO/Jet ne connaissent pas Access (donc ne connaissent pas les formulaires) et toute expression non reconnue par leur évaluateur est considérée comme un paramètre.
Or, s'il y a un paramètre, il faut lui transmettre une valeur, faute de quoi on provoque une erreur d'exécution.

Il y a un remède simple qui consiste à faire appel à la fonction Eval() qui rend le contrôle à Access pour évaluer ces "expressions" (j'appelle "expression" ce qui est considéré par ADO/DAO comme un nom de paramètre).

Première possibilité: réécrire toutes les requêtes Access pour y placer un appel à la fonction Eval(). Mais ce peut être assez lourd.
De plus, il faut respecter la syntaxe anglo-saxonne (à savoir Forms![...] au lieu de Formulaires![...]) car Eval() ne fait pas la traduction.

Au lieu de Formulaires!FormulaireTest!TexteTest, on doit écrire Eval("Forms!FormulaireTest!TexteTest").

Autre possibilité: utiliser une fonction qui se charge d'interpréter les paramètres de la requête pour faire appel à Eval() et si l'évaluation n'aboutit pas, une boîte de dialogue InputBox (saisie) permet à l'utilisateur de saisir la valeur du paramètre.

Dans cette contribution, je donne le code de 2 fonctions génériques permettant de récupérer un Recordset DAO ou ADO (selon vos préférences

) à partir d'une source de données paramétrée: requête ACCESS ou une commande SQL SELECT.

Seul ce premier paramètre (requête ou commande SQL) est obligatoire.
Les autres paramètres de la fonction sont optionnels et permettent de préciser:
- le type de Recordset ou de curseur,
- des options supplémentaires (par exemple, pour contrôler le verrouillage des données),
- de fournir l'objet d'accès à la base de données (DAO.Database ou ADO.Connection)
- de transmettre les valeurs des paramètres de la requête au moyen d'une VBA.Collection.

Fonction DAO_GenericOpenRecordset():

Paramètres de la fonction DAO_GenericOpenRecordset():
• strSQL (String) nom d'une requête Access, ou texte d'une commande SQL SELECT
• eRecordsetType (DAO.RecordsetTypeEnum) type de Recordset (facultatif, par défaut dbOpenDynaset)
• eRecordsetOptions (DAO.RecordsetOptionEnum) option de Recordset (facultatif)
• eLockType (DAO.LockTypeEnum) type de verrouillage si modification d'un enregistrement (facultatif)
• oDB (DAO.Database) objet base de données où la requête est exécutée (facultatif, par défaut Application.CurrentDB)
• bOptimizeEval (Boolean) optimiser les évaluations en mémorisant la valeur des paramètres (facultatif, par défaut True)
• oCollParamValues (Collection) permet de transmettre un ensemble de valeurs indexées par le "nom de paramètre" (facultatif)

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
Public Function DAO_GenericOpenRecordset(strSQL As String, _
                            Optional eRecordsetType As DAO.RecordsetTypeEnum = dbOpenDynaset, _
                            Optional eRecordsetOptions As DAO.RecordsetOptionEnum, _
                            Optional eLockType As DAO.LockTypeEnum, _
                            Optional oDB As DAO.Database, _
                            Optional bOptimizeEval As Boolean = True, _
                            Optional oCollParamValues As Collection = Nothing) As DAO.Recordset
    Dim p_oDB As DAO.Database, oQD As DAO.QueryDef, oParam As DAO.Parameter
    Dim oRS As DAO.Recordset
    Dim oCollEval As Collection
    Dim sExpr As String, sExprColl As String, vValue As Variant
    Dim i As Integer, v As Variant, bAddItem As Boolean
 
    If oDB Is Nothing Then
        Set p_oDB = Application.CurrentDb
    Else
        Set p_oDB = oDB
    End If
 
    If bOptimizeEval Then
        If oCollParamValues Is Nothing Then
            Set oCollEval = New Collection
        Else
            Set oCollEval = oCollParamValues
        End If
    End If
 
    On Error Resume Next
 
    Set oQD = p_oDB.QueryDefs(strSQL)
    If Err = 3265 Then
        Set oQD = p_oDB.CreateQueryDef("", strSQL)
    End If
 
    For Each oParam In oQD.Parameters
 
        bAddItem = True
        sExprColl = oParam.Name
 
        For i = 1 To 3
 
            Select Case i
            Case 1
                ' 1er passage: prendre "l'expression paramètre", telle quelle
                sExpr = sExprColl
            Case 2
                ' 2ème passage: normaliser "l'expression paramètre"
                sExpr = vbNullString
 
                For Each v In Array("[Forms]!", "[Formulaires]!", "Formulaires!")
                    If InStr(1, sExprColl, v) = 1 Then
                        sExpr = Replace(sExprColl, v, "Forms!")
                        Exit For
                    End If
                Next v
 
            Case Else
                ' 3ème et dernier passage: Paramètre non évaluable
                ' Demander la saisie de la valeur du paramètre dans une InputBox
                ' et sortir
                vValue = Null
                vValue = InputBox(sExprColl)
 
                Exit For
            End Select
 
            ' Rechercher l'expression dans la collection
            If bOptimizeEval And Len(sExpr) > 0 Then
                Err.Clear
 
                ' couple <sExpr, Value> déja mémorisé dans la collection ?
                vValue = oCollEval.Item(sExpr)
 
                If Err.Number = 0 Then
                    ' OK - valeur trouvée dans la collection
                    ' sortir de la boucle For
                    bAddItem = False
                    Exit For
                End If
            End If
 
            ' Evaluer l'expression
            Err.Clear
            vValue = Eval(sExpr)
 
            Select Case Err.Number
            Case 0
                ' évaluation réussie !
                Exit For
 
            Case 2482, 2451, 2450, 2434, 2425
                ' 2482 = Impossible de touver un nom entré dans l'expression
                ' 2451 = Le nom entré dans l'expression fait référence à un état qui n'existe pas
                ' 2450 = Le nom entré dans l'expression fait référence à un formulaire qui n'existe pas
                ' 2434 = La syntaxe de l'expresion n'est pas correcte
                ' 2425 = L'expression comporte un nom de fonction introuvable
 
            Case Else
                ' autres erreurs ?
            End Select
 
        Next i
 
        If bOptimizeEval And bAddItem Then
            oCollEval.Add vValue, sExprColl
            If Len(sExpr) > 0 And sExpr <> sExprColl Then
                oCollEval.Add vValue, sExpr
            End If
        End If
 
        oParam.Value = vValue
    Next
 
    On Error GoTo 0
 
    If eRecordsetOptions = 0 And eLockType = 0 Then
        Set oRS = oQD.OpenRecordset(eRecordsetType)
    ElseIf eRecordsetOptions > 0 And eLockType = 0 Then
        Set oRS = oQD.OpenRecordset(eRecordsetType, eRecordsetOptions)
    ElseIf eRecordsetOptions = 0 And eLockType > 0 Then
        Set oRS = oQD.OpenRecordset(eRecordsetType, eLockType)
    ElseIf eRecordsetOptions > 0 And eLockType > 0 Then
        Set oRS = oQD.OpenRecordset(eRecordsetType, eRecordsetOptions, eLockType)
    End If
    Set DAO_GenericOpenRecordset = oRS
 
    Set oParam = Nothing
    Set oRS = Nothing
    Set oQD = Nothing
    Set p_oDB = Nothing
 
End Function

Fonction ADO_GenericOpenRecordset():

Paramètres de la fonction ADO_GenericOpenRecordset():
• strSQL (String) nom d'une requête Access, ou texte d'une commande SQL SELECT
• eCursorType (ADODB.CursorTypeEnum) type de curseur (facultatif, par défaut adOpenForwardOnly)
• eLockType (ADODB.LockTypeEnum) type de verrouillage si modification d'un enregistrement (facultatif, par défaut adLockReadOnly)
• eCommandType (ADODB.CommandTypeEnum) (facultatif, par défaut adCmdUnknown)
• oConn (ADODB.Connection) objet connexion sur la source de données où la requête est exécutée (facultatif, par défaut Application.CurrentProject.Connection)
• bOptimizeEval (Boolean) optimiser les évaluations en mémorisant la valeur des paramètres (facultatif, par défaut True)
• oCollParamValues (Collection) permet de transmettre un ensemble de valeurs indexées par le "nom de paramètre" (facultatif)

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
Public Function ADO_GenericOpenRecordset(ByVal strSQL As String, _
                            Optional ByVal eCursorType As ADODB.CursorTypeEnum = adOpenForwardOnly, _
                            Optional ByVal eLockType As ADODB.LockTypeEnum = adLockReadOnly, _
                            Optional ByVal eCommandType As ADODB.CommandTypeEnum = adCmdUnknown, _
                            Optional oConn As ADODB.Connection, _
                            Optional ByVal bOptimizeEval As Boolean = True, _
                            Optional oCollParamValues As Collection = Nothing) As ADODB.Recordset
    Dim p_oConn As ADODB.Connection
    Dim oCmd As ADODB.Command
    Dim oParam As ADODB.Parameter
    ', oQD As DAO.QueryDef, oParam As DAO.Parameter
    Dim oRS As ADODB.Recordset
    Dim oCollEval As Collection
    Dim sExpr As String, sExprColl As String, vValue As Variant
    Dim i As Integer, v As Variant, bAddItem As Boolean
 
    If oConn Is Nothing Then
        Set p_oConn = CurrentProject.Connection
    Else
        Set p_oConn = oConn
    End If
 
    If bOptimizeEval Then
        If oCollParamValues Is Nothing Then
            Set oCollEval = New Collection
        Else
            Set oCollEval = oCollParamValues
        End If
    End If
 
    On Error Resume Next
 
    Set oCmd = New ADODB.Command
    Set oCmd.ActiveConnection = p_oConn
    oCmd.CommandText = strSQL
 
    If eCommandType = adCmdUnknown Then
        If Trim(strSQL) Like "SELECT *" Then
            eCommandType = adCmdText
        Else
            eCommandType = adCmdTable
        End If
    End If
    oCmd.CommandType = eCommandType
 
    oCmd.Parameters.Refresh
 
    For Each oParam In oCmd.Parameters
 
        bAddItem = True
        sExprColl = oParam.Name
 
        For i = 1 To 3
 
            Select Case i
            Case 1
                ' 1er passage: prendre "l'expression paramètre", telle quelle
                sExpr = sExprColl
            Case 2
                ' 2ème passage: normaliser "l'expression paramètre"
                sExpr = vbNullString
 
                For Each v In Array("[Forms]!", "[Formulaires]!", "Formulaires!")
                    If InStr(1, sExprColl, v) = 1 Then
                        sExpr = Replace(sExprColl, v, "Forms!")
                        Exit For
                    End If
                Next v
 
            Case Else
                ' 3ème et dernier passage: Paramètre non évaluable
                ' Demander la saisie de la valeur du paramètre dans une InputBox
                ' et sortir
                vValue = Null
                vValue = InputBox(sExprColl)
 
                Exit For
            End Select
 
            ' Rechercher l'expression dans la collection
            If bOptimizeEval And Len(sExpr) > 0 Then
                Err.Clear
 
                ' couple <sExpr, Value> déja mémorisé dans la collection ?
                vValue = oCollEval.Item(sExpr)
 
                If Err.Number = 0 Then
                    ' OK - valeur trouvée dans la collection
                    ' sortir de la boucle For
                    bAddItem = False
                    Exit For
                End If
            End If
 
            ' Evaluer l'expression
            Err.Clear
            vValue = Eval(sExpr)
 
            Select Case Err.Number
            Case 0
                ' évaluation réussie !
                Exit For
 
            Case 2482, 2451, 2450, 2434, 2425
                ' 2482 = Impossible de touver un nom entré dans l'expression
                ' 2451 = Le nom entré dans l'expression fait référence à un état qui n'existe pas
                ' 2450 = Le nom entré dans l'expression fait référence à un formulaire qui n'existe pas
                ' 2434 = La syntaxe de l'expresion n'est pas correcte
                ' 2425 = L'expression comporte un nom de fonction introuvable
 
            Case Else
                ' autres erreurs ?
            End Select
 
        Next i
 
        If bOptimizeEval And bAddItem Then
            oCollEval.Add vValue, sExprColl
            If Len(sExpr) > 0 And sExpr <> sExprColl Then
                oCollEval.Add vValue, sExpr
            End If
        End If
 
        oParam.Value = vValue
    Next
 
    On Error GoTo 0
 
    Set oRS = New ADODB.Recordset
    oRS.Open oCmd, CursorType:=eCursorType, LockType:=eLockType
 
    Set ADO_GenericOpenRecordset = oRS
 
    Set oParam = Nothing
    Set oRS = Nothing
    Set oCmd = Nothing
    Set p_oConn = Nothing
 
End Function

Liens vers les discussions et messages qui sont à l'origine de cette contribution:

• Réutiliser le code SQL d'une requête:
http://www.developpez.net/forums/d21...quete-critere/

• Fonction générique pour ouvrir un Recordset, à partir d'une requête Access ou d'une requête SQL (discussion en anglais):
http://www.utteraccess.com/forums/sh...ll#Post1627801
_

**User** · 25/05/2009, 19h58

Bonjour,

Félicitations !

J'ai pu tester avec DAO.

(Comme ça on peut manipuler les données de requêtes déjà compilées (enregistrées))

cependant, il me semble que tu as une autre possibilité en DAO dans la faq je crois:

du style:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
Dim req as DAO.QueryDef 
Dim rst As DAO.RecordSet
 
Set req = CurrentDb.QueryDefs("LaRequete")
req.Parameters("[Forms]![FormulaireTest]![Valeur]") = Forms!FormulaireTest!Valeur
Set rst = req.OpenRecordset()

Il est vrai qu'avec ta fonction c'est directe

A toi

**=JBO=** · 27/05/2009, 10h49

Bonjour User et merci pour ton message.

Envoyé par User

J'ai pu tester avec DAO.
[...]
Cependant, il me semble que tu as une autre possibilité en DAO dans la faq je crois:

Voilà un lien vers une réponse de la FAQ:
Comment utiliser en VBA une requête existante ?

Comme je n'ai pas donné d'exemple, je profite de l'occasion pour illustrer l'utilisation de la fonction générique pour DAO en m'inspirant du code que tu nous donnes.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Dim rst As DAO.RecordSet
 
Set rst = DAO_GenericOpenRecordset("LaRequete")

[Sources] VBA ouvrir Recordset (ADO/DAO) sur requête paramétrée basée sur formulaires

Contribuez

Discussions similaires

Partager

Partager