Bonjour,

j'ai une macro liée à un code SQl qui va me chercher toute ma facturation faite avec un client/fournisseur.

la macro fonctionne parfaitement à partir du moment ou ne joue la requête qu'une seule fois. Si je souhaite avoir un nouvel état, il faut que je ferme mon fichier, que je le réouvre, puis que je rejoue...

Je pense que le problème vient de la mémoire virtuelle de la requête SQl.
Y a t il un code pour vider cette mémoire (reset recordset ??)

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
 
 
Option Explicit
Dim cnnConn As ADODB.Connection
Dim rstRecordset As ADODB.Recordset
Dim cmdCommand As ADODB.Command
Dim sSQL As String
Const cstTimeOut As Long = 120 * 60 'en secondes
Dim DestCell As Range
 
    'Chargement de la BASE
 
Sub ChargeData_FOUR(sCritDateDeb As String, sCritDatefin As String, sCritCodeFour As String)
 
 
sSQL = sSQL + " "
 
sSQL = sSQL + " Select 'C_PF' as SOCIETE, e_contrepartieaux,t_commentaire,e_etablissement, e_journal, et_libelle, e_refinterne, sum(e_debit-e_credit) as SOLDE, e_periode"
sSQL = sSQL + " from C_pf..ecriture"
sSQL = sSQL + " left join C_Model_PF..tiers ON e_contrepartieaux = t_auxiliaire"
sSQL = sSQL + " left join C_PF..etabliss ON e_etablissement = et_etablissement"
sSQL = sSQL + " where e_general like '6%'"
sSQL = sSQL + " and e_datecomptable between '" & sCritDateDeb & "' and '" & sCritDatefin & "'"
sSQL = sSQL + " and e_journal in ('AC','ACO')"
sSQL = sSQL + " and e_contrepartieaux = '" & sCritCodeFour & "'"
sSQL = sSQL + " group by e_contrepartieaux,t_commentaire,e_etablissement, et_libelle, e_journal, e_periode, e_refinterne"
 
sSQL = sSQL + " Union all"
 
 [...]
 
    cmdCommand.CommandText = sSQL
    cmdCommand.CommandType = adCmdText
    cmdCommand.Execute
 
  'Open the recordset.
    rstRecordset.Open cmdCommand
 
  'Populer la feuille
    DestCell.Select
    DestCell.CopyFromRecordset rstRecordset
 
  'Fermer the recordset.
    rstRecordset.Close
 
End Sub
 
Sub LANCEMEN()
 
'Désactivation du recalcul automatique
       Application.Calculation = xlCalculationManual
 
'Cacher l'actualisation de l'écran
       Application.ScreenUpdating = False
 
'Active l'affichage de la barre d'état
        Application.DisplayStatusBar = True
 
'Ouverture de la connexion à la base de donnée
        Set cnnConn = New ADODB.Connection
        cnnConn.ConnectionString = "UID=tu y as cru;PWD=tu y as cru;DRIVER={SQL Server};Server=S1SRVBDD10;Database=XxXxXxXx"
        cnnConn.Open
 
'Déclaration de la commande SQL
        Set cmdCommand = New ADODB.Command
        Set cmdCommand.ActiveConnection = cnnConn
 
'Spécification du timeout
        cmdCommand.CommandTimeout = cstTimeOut
 
'Déclaration du Recordset
        Set rstRecordset = New ADODB.Recordset
        Set rstRecordset.ActiveConnection = cnnConn
 
 'Mise à jour
        Application.StatusBar = "Lancement de la requête SQL"
 
 
 'Lancement de la mise a jour
    Application.StatusBar = "Mise à jour de la requête SQL"
 
 
  '-------------------------------------------------- /-/ --------------------------------------------------------
 
        Sheets(Feuil1.Name).Select
 
        Set DestCell = Range("A2")          'Cellule de destination
        Range("A2:AG65000").Clear            'Effacer les données présentes
 
 
        Call ChargeData(Range("DATE_DEBUT").Value, Range("DATE_FIN").Value, Range("CODE").Value)
 
 
  cnnConn.Close
  Set cnnConn = Nothing
  Set rstRecordset = Nothing
  Set cmdCommand = Nothing
 
'Restore la barre d'état Excel d'origine.
Application.StatusBar = False
 
'Réactivation du raffraichissement écran
Application.ScreenUpdating = True
 
 'Enlève le sablier
Application.Cursor = xlDefault
 
 'Réactivation du recalcul automatique
Application.Calculation = xlCalculationAutomatic
 
 'Message de fin de traitement
MsgBox "Mise à jour des données terminée !", vbInformation + vbOKOnly, "Fin de traitement"
 
 
End Sub