ADODB temporisation connexion ? (vba excel)

**meud007** · 19/05/2018, 20h06

Bonjour,
Je cherche à piloter ma base Access via Excel en utilisant ADODB, et en suivant les différents tutos du site.

L'interface Excel est constituée de 4 listBox permettant de sélectionner les données à extraire.

Après sélection des options par l'opérateur, le code se connecte à la BBD, crée une table temporaire avec les données filtrée, puis deux autre tables temporaires les pour les calculs.
Il rapatrie les données dans Excel, supprime les tables temporaires et ferme la connexion.
Pour les calculs, j'utilise une requête qui extrait la moyenne et l'écart type de la table données temporaire.

Au premier tour, ça marche impec, mais à la deuxième exécution, la requête de calcul de moyenne ne renvois aucun résultat. Or, les données sont là.
Si je met un point d'arrêt et que j'execute le code en pas à pas, ça mache.
Si je met la ligne

Code :

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

Application.Wait Now + TimeValue("0:00:01")

, ça marche trois ou quatre fois sur 5.
Ca ressemble à un problème de temporisation, mais je ne vois pas où est l'erreur.

Ca parle à quelqu'un ?

Voici mon code de connexion (dans un module de classe)

Code :

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
 
Option Explicit
Public Fichier As Fichier
Public BBD As ADODB.Connection
Private PC$
 
Public Sub ConnexionBase()
    Dim sql$
    Set BBD = New ADODB.Connection
    With BBD
        sql = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Fichier.Chemin & ";Mode=Share Deny None;Persist Security Info=False;Jet OLEDB:Database Password=; "
        .ConnectionString = sql
        .ConnectionTimeout = 30
        .Open
        .CursorLocation = adUseServer
    End With
End Sub

Et voici ma boucle avec la ligne Wait

Code :

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
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
 
Public Sub TriDonnées()
    Dim r As ADODB.Recordset, sql$, c As ADODB.Command, nP%, Opt As Boolean, i%
    PC = Environ("COMPUTERNAME")
    On Error GoTo gErr
'---Sort si toutes les sélections (Analyse, Lot, Composé, Paramètre) non effectuées
    With Interface
            If .Lot.ListIndex <> -1 And .Paramètre.ListIndex <> -1 And .Analyse.ListIndex <> -1 And .Composé.ListIndex <> -1 Then sql = "SELECT Donnée.*, Paramètres.Nom AS Paramètre, Composés.Nom AS Composé, Lots.Nom AS Lot, Paramètres.nComposé AS nComposé, Séries.DatePréparation, Séries.Commentaire AS [Commentaire série], TabUtilisateur.Utilisateur into [" & PC & " Données] FROM ((((Donnée INNER JOIN Paramètres ON Donnée.nParamètre = Paramètres.nParamètre) INNER JOIN Lots ON Donnée.nLot = Lots.nLot) INNER JOIN Composés ON Paramètres.nComposé = Composés.nComposé) INNER JOIN Séries ON Donnée.nSérie = Séries.nSérie) INNER JOIN TabUtilisateur ON Séries.nPréparateur = TabUtilisateur.nUtilisateur WHERE (((Paramètres.Nom)='" & .Paramètre & "') AND ((Composés.Nom)='" & .Composé & "') AND ((Lots.Nom)='" & .Lot & "') AND ((Lots.nProtocole)=" & .Analyse & ")) ORDER BY Donnée.DateAcquisition;" Else Exit Sub
    End With
    ExitSub = True
    Données.Cells.Clear
    Set c = New ADODB.Command
    Set r = New ADODB.Recordset
    If bdCIQ Is Nothing Then Set bdCIQ = New bdCIQ
    bdCIQ.ConnexionBase
    With c
        .ActiveConnection = bdCIQ.BBD
'-------Filtre les données correspondant aux choix et crée une Table Temporaire [" & PC & " Données]
        sql = "SELECT Donnée.*, Paramètres.Nom AS Paramètre, Composés.Nom AS Composé, Lots.Nom AS Lot, Paramètres.nComposé AS nComposé, Séries.DatePréparation, Séries.Commentaire AS [Commentaire série], TabUtilisateur.Utilisateur into [" & PC & " Données] FROM ((((Donnée INNER JOIN Paramètres ON Donnée.nParamètre = Paramètres.nParamètre) INNER JOIN Lots ON Donnée.nLot = Lots.nLot) INNER JOIN Composés ON Paramètres.nComposé = Composés.nComposé) INNER JOIN Séries ON Donnée.nSérie = Séries.nSérie) INNER JOIN TabUtilisateur ON Séries.nPréparateur = TabUtilisateur.nUtilisateur WHERE (((Paramètres.Nom)='" & Interface.Paramètre & "') AND ((Composés.Nom)='" & Interface.Composé & "') AND ((Lots.Nom)='" & Interface.Lot & "') AND ((Lots.nProtocole)=" & Interface.Analyse & ")) ORDER BY Donnée.DateAcquisition;"
        .CommandText = sql
        .Execute
'-------Calcul Statistiques mobiles (moyenne, ecart type) à partir de la Table Temporaire [" & PC & " Données]
        'SELECT Avg([PCMeud Données].Valeur) AS Cible, 100*[DS]/[Cible] AS CV, [PCMeud Données].nParamètre, StDev([PCMeud Données].Valeur) AS DS, Count([PCMeud Données].nValeur) AS n FROM [PCMeud Données] WHERE ((([PCMeud Données].Etat)<>'r')) GROUP BY [PCMeud Données].nParamètre;
 
'---------PLANTE ICI SANS TEMPORISATION !!!!!! ---------------
 
         Application.Wait Now + TimeValue("0:00:01")
'---------------------------------------------------------------
        sql = "SELECT Avg([" & PC & " Données].Valeur) AS Cible, 100*[DS]/[Cible] AS CV, [" & PC & " Données].nParamètre, StDev([" & PC & " Données].Valeur) AS DS, Count([" & PC & " Données].nValeur) AS n FROM [" & PC & " Données] WHERE ((([" & PC & " Données].Etat)<>'r')) GROUP BY [" & PC & " Données].nParamètre; "
        r.Open sql, bdCIQ.BBD.ConnectionString, adOpenStatic, adLockUnspecified
        If Not r.EOF Then
            With Interface
                .Cmobile = r!cible
                If r!cible > 1 Then
                    .Cmobile = Round(r!cible, 2)
                ElseIf r!cible > 10 Then
                    .Cmobile = Round(r!cible, 1)
                ElseIf r!cible > 100 Then
                    .Cmobile = Round(r!cible, 0)
                Else
                    .Cmobile = Round(r!cible, 3)
                End If
                .CVmobile = Round(r!CV, 1)
                .Pmobile = r!n
                nP = r!nParamètre
            End With
        Else 'Pas de données
            With Interface
                .Cmobile = "-"
                .CVmobile = "-"
                .Pmobile = 0
            End With
 
        End If
        r.Close
        If Interface.Pmobile = 0 Then
'-----------Suppression des tables temporaires
            .CommandText = "Drop Table [" & PC & " Données]"
            .Execute
            MsgBox "Aucune donnée"
            GoTo Fin
        End If
 
'-------Vérifie si au moins un point Nouveau dans Table Temporaire [" & PC & " Données]
        sql = "SELECT nParamètre, Count(nValeur) AS n FROM [" & PC & " Données] GROUP BY nParamètre, Etat HAVING ((([Etat])='n' Or ([Etat])='v'));"
 
        r.Open sql, bdCIQ.BBD.ConnectionString, adOpenStatic, adLockUnspecified
        If Not r.EOF Then Interface.Pmobile = r!n Else Interface.Pmobile = 0
        'nP = r!nParamètre
        r.Close
 
 
 
'-------Crée une Table Temporaire [" & PC & " Cible]
        sql = "Create Table [" & PC & " Cible] (nP Long, Cible Double, CV Double, DS Double, primary key (nP))"
        .CommandText = sql
        .Execute
'-------Reset les options d'interface
        With Interface
            .OptionOpt.Enabled = False
            .OptionValidation_niveau_bas.Enabled = False
            .OptionValidation_niveau_moyen.Enabled = False
            .OptionValidation_niveau_haut.Enabled = False
        End With
'-------Recherche Optimisation
        sql = "SELECT Last(Optimisations.Cible) AS Cible, Last(Optimisations.CV) AS CV, Last(Optimisations.DateOptimisation) AS DateOptimisation, Last(TabUtilisateur.Utilisateur) AS Biologiste, Optimisations.nParamètre AS nParamètre, Lots.Nom "
        sql = sql & "FROM (((Optimisations INNER JOIN Paramètres ON Optimisations.nParamètre = Paramètres.nParamètre) INNER JOIN Lots ON Optimisations.nLot = Lots.nLot) INNER JOIN TabUtilisateur ON Optimisations.nBiologiste = TabUtilisateur.nUtilisateur) INNER JOIN [" & PC & " Données] ON (Lots.nLot = [" & PC & " Données].nLot) AND (Paramètres.nParamètre = [" & PC & " Données].nParamètre) "
        sql = sql & " GROUP BY Optimisations.nParamètre, Lots.Nom;"
        r.Open sql, bdCIQ.BBD.ConnectionString, adOpenStatic, adLockUnspecified
        If Not r.EOF Then
            Opt = True
            While Not r.EOF
'---------------Injection de la cible et DS de l'optimisation dans la Table Temporaire [" & PC & " Cible]
                sql = "INSERT INTO [" & PC & " Cible] ( Cible, CV, nP, DS ) Values (" & Replace(r!cible, ",", ".") & ", " & Replace(r!CV, ",", ".") & ", " & r!nParamètre & ", " & Replace((0.01 * r!CV * r!cible), ",", ".") & ");"
                .CommandText = sql
                .Execute
                'METTRE INITIALES BIOLOGISTE
                With Interface
                    .CVOpt = Round(r!CV, 1)
                    If r!Biologiste <> "Fournisseur" Then .Dopt = Format(r!DateOptimisation, "dd/mm/yy") Else .Dopt = r!Biologiste
                    .OptionOpt.Enabled = True
                    .OptionOpt.Value = True
                    If r!cible > 1 Then
                        .COpt = Round(r!cible, 2)
                    ElseIf r!cible > 10 Then
                        .COpt = Round(r!cible, 1)
                    ElseIf r!cible > 100 Then
                        .COpt = Round(r!cible, 0)
                    Else
                        .COpt = Round(r!cible, 3)
                    End If
                    .CVOpt = Round(r!CV, 1)
                End With
                r.MoveNext
            Wend
'-----------L'affichage correspond au dernier paramètre en cas de sélection  multiple !!!
        Else
            With Interface
                .OptionOpt.Enabled = False
                .Dopt = "-"
                .COpt = "-"
                .CVOpt = "-"
            End With
        End If
        r.Close
'-------Recherche Validation
        sql = "SELECT Validations.Valeur, Validations.CV, Validations.Niveau, Paramètres.Nom, Composés.Nom FROM (Validations INNER JOIN Paramètres ON Validations.nParamètre = Paramètres.nParamètre) INNER JOIN Composés ON Paramètres.nComposé = Composés.nComposé WHERE (((Paramètres.Nom)='" & Interface.Paramètre & "') AND ((Composés.Nom)='" & Interface.Composé & "'));"
        r.Open sql, bdCIQ.BBD.ConnectionString, adOpenStatic, adLockUnspecified
        If Not r.EOF Then
            'recherche du niveau le plus bas
            With Interface
                .OptionDonnées.Enabled = True
                .OptionValidation_niveau_bas.Enabled = True
                .OptionValidation_niveau_moyen.Enabled = True
                .OptionValidation_niveau_haut.Enabled = True
            End With
            MsgBox "Validation à écrire"
        Else 'Pas de validation : utilisation de moyenne mobile et écartype
            If Not Opt Then
 
 
                sql = "INSERT INTO [" & PC & " Cible] ( nP, Cible, DS, CV ) SELECT [" & PC & " Données].nParamètre, Avg([" & PC & " Données].Valeur) AS Cible, StDev([" & PC & " Données].Valeur) AS DS, 100*[DS]/[Cible] AS CV FROM [" & PC & " Données] GROUP BY [" & PC & " Données].nParamètre, [" & PC & " Données].Etat HAVING ((([PCMEUD Données].Etat)<>'r') AND ((Count([PCMEUD Données].nValeur))>2));"
                .CommandText = sql
                .Execute
            End If
            With Interface
                .OptionDonnées.Enabled = True
                If Not Opt Then .OptionDonnées.Value = True
            End With
 
        End If
        r.Close
'-------Crée une Table Temporaire [" & PC & " Table] avec clé autoincrémentée
        sql = "Create Table [" & PC & " Table] (Indice Counter, ZScore Double, [Date Acquisition] Date, [Date Série] Date, Valeur Double, Etat VarChar(1), Lot VarChar(255), primary key (Indice))" ' nLotProduit Long, [Masse Pesée] Double, [Unité Masse] VarChar(3), Volume Double, [Unité Volume] VarChar(3), Concentration double, [Unité Concentration] VarChar(3), nUtilisateur Integer, [Date de Fabrication] Date, Diluant VarChar(50), Commentaire LongText, nPiece Integer, nCongelateur Integer, nTemperature Integer, Boite VarChar(25), [Terminée le] Date, primary key (nSM))"
        .CommandText = sql
        .Execute
'-------Injecte les données dans Table Temporaire [" & PC & " Table]
         'sql = "INSERT INTO [PCMEUD Table] ( ZScore, [Date Acquisition], Etat, Valeur, Lot, [Date Série] ) SELECT ([Valeur]-[Cible])/[DS] AS ZScore, [PCMEUD Données].DateAcquisition, [PCMEUD Données].Etat, [PCMEUD Données].Valeur, [PCMEUD Données].Lot, [PCMEUD Données].DatePréparation FROM [PCMEUD Données] INNER JOIN [PCMEUD Cible] ON [PCMEUD Données].nParamètre = [PCMEUD Cible].nP order by [PCMEUD Données].DateAcquisition;"
        sql = "INSERT INTO [" & PC & " Table] ( ZScore, [Date Acquisition], Etat, Valeur, Lot, [Date Série] ) SELECT ([Valeur]-[Cible])/[DS] AS ZScore, [" & PC & " Données].DateAcquisition, [" & PC & " Données].Etat, [" & PC & " Données].Valeur, [" & PC & " Données].Lot, [" & PC & " Données].DatePréparation FROM [" & PC & " Données] INNER JOIN [" & PC & " Cible] ON [" & PC & " Données].nParamètre = [" & PC & " Cible].nP order by [" & PC & " Données].DateAcquisition;"
        .CommandText = sql
        .Execute
'-------Requete croisée dynamique pour graphique
        sql = "TRANSFORM Avg([" & PC & " Table].ZScore) AS MoyenneDeZScore SELECT [" & PC & " Table].Indice AS indice, [" & PC & " Table].[Date Acquisition] FROM [" & PC & " Table] GROUP BY [" & PC & " Table].Indice, [" & PC & " Table].[Date Acquisition] PIVOT [" & PC & " Table].Etat;"
        sql = "TRANSFORM Avg([" & PC & " Table].ZScore) AS MoyenneDeZScore SELECT [" & PC & " Table].Indice FROM [" & PC & " Table] GROUP BY [" & PC & " Table].Indice PIVOT [" & PC & " Table].Etat;"
 
        r.Open sql, bdCIQ.BBD.ConnectionString, adOpenStatic, adLockUnspecified
        For i = 1 To r.Fields.Count
            Données.Cells(1, i) = r.Fields(i - 1).Name
        Next
        Données.Cells(2, 1).CopyFromRecordset r
        r.Close
 
 
 
'-------Suppression des tables temporaires
        .CommandText = "Drop Table [" & PC & " Données]"
        .Execute
        .CommandText = "Drop Table [" & PC & " Cible]"
        .Execute
        .CommandText = "Drop Table [" & PC & " Table]"
        .Execute
 
 
    End With
'
'
'
 
'    Graphique.Requery
'    Points.RowSource = "SELECT d.* FROM d WHERE (((d.Etat)='v' Or (d.Etat)='n')) ORDER BY Abs([ZScore]) DESC; "
'
'    MiseEnFormeSeries
'    Centre
'
'Stop
Fin:
    On Error GoTo 0
    ExitSub = False
    bdCIQ.BBD.Close
    Set r = Nothing
    Set c = Nothing
    Exit Sub
gErr:
    MsgBox Err.Description
    Stop
'    'msgbox asc(""")
'    If Err.Number = -2147217900 Then
'        c.CommandText = "Drop Table [" & Mid(Err.Description, InStr(1, Err.Description, Chr(34)), 10) & " Données]"
'    End If
'
'    End If
'    bdCIQ.BBD.Close
'
'    Set bdCIQ = Nothing
    Resume
End Sub

**meud007** · 20/05/2018, 13h56

Bonjour,
Il y a du mieux mais je pense que la solution n'est pas propre.
Le code marche si à la place de Application.Wait, je ferme la connexion puis je la ré-ouvre.
C'est donc une histoire de Mise à jour. Il doit bien y avoir un autre moyen ? Le code est un peu plus lent (toujours moins qu'avec Wait dont le temps mini testé avec Sleep est de 500 (0.5 ms?)
Merci pour vos propositions.
Meud

Invité · 21/05/2018, 11h04

Bonjour,
Il faut déclarer ta Connection en public dans l'entête d'un module standard et effectuer la connexion une fois pour tout le traitement.

Il faut placer Application.Wait Now + TimeValue("0:00:01") juste avant le End Sub pour éviter que ta procédure ne redémarre avant la fin du traitement de son exécution précédents.

ADODB temporisation connexion ? (vba excel)

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager