VBA - SQL : probleme requetes multiples
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:
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 |