[XL-2003] probleme VBA et SQL

Bonjour,

j'ai un petit code VBA qui me pose probleme et je n'ai aucune idée de l'origine de ce probleme.
En quelques mots, je fais tourner une requete sql qui me ramene X lignes avec 6 items : je les insere dans les colonnes A à F.
Pour chacune de ces X lignes, les gens peuvent ajouter manuellement des commentaires en colonne G et H.
Ce listing évolue tout le temps (en general, ligne en plus) et les gens qui revoie le listing voudrait garder leur commentaire.
Donc, en plus de remplir de facon automatique les colonnes A a F, l'idee du programme est de restituer, a la bonne place, les commentaires en G et H.

J'ai mis le code en dessous.
Pour expliquer rapidement, j'ai un bouton dans ma feuille excel qui active ActionButton.
Cette procedure appelle :
- ouverture d'une connection ODBC
- stockage dans un tableau des commentaires manuels
- listing automatique
- restauration des commentaires
- fermeture de la connection

Je me sers de la colonne A, comme clé: c'est l'identifiant unique du record.

Le programme est en aucun cas optimisé. Il est simple et on souhaite que ça marche, c'est tout.
Le probleme est donc que sur certaines lignes, il restaure des commentaires qui n'ont jamais été rentrés !!!!

J'ai regardé en détail le programme mais je ne vois aucun souci.
Y aurait-il un "tips and tricks" sur VBA ou Excel ? ;)
Le listing retourne pres de 4000 lignes.

Merci d'avance si vous prenez la peine de lire mon topic :D

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
116
117
118
119
120
Public CurrentConnection As ADODB.Connection
Public RevisionDates() As String
 
 
Public Sub OpenConnection()
 
    DSN = "xxxxxxx"
    User = "xxxxxxx"
    Password = "xxxxxxx"
 
    Set CurrentConnection = New ADODB.Connection
 
 
    With CurrentConnection
        .ConnectionString = "DSN=" & DSN & ";UID=" & User & ";PWD=" & Password & ";"
        .CursorLocation = adUseClient
 
        .Open
    End With
End Sub
 
 
Public Sub CloseConnection()
    CurrentConnection.Close
    Set CurrentConnection = Nothing
End Sub
 
 
 
Sub ActionButton()
 
    ActiveWorkbook.Sheets("Notes").Activate
 
    Call OpenConnection
 
    Call StoreData
 
    Range("A5:H65536").Select
    Selection.ClearContents
 
    Call GetListing
 
    Call RestoreData
 
    Call CloseConnection
 
    Set QueryResults = Nothing
End Sub
 
 
 
Sub StoreData()
    current_row = 5
    table_size = 0
    While ActiveSheet.Cells(current_row, "A") <> vbNullString
        If ActiveSheet.Cells(current_row, "G") <> vbNullString Or ActiveSheet.Cells(current_row, "H") <> vbNullString Then
            table_size = table_size + 1
        End If
        current_row = current_row + 1
    Wend
 
 
        ReDim RevisionDates(1 To 3, 1 To table_size)
 
        current_row = 5
        r = 1
        While ActiveSheet.Cells(current_row, "A") <> vbNullString
            If ActiveSheet.Cells(current_row, "G") <> vbNullString Or ActiveSheet.Cells(current_row, "H") <> vbNullString Then
                RevisionDates(1, r) = ActiveSheet.Cells(current_row, "A")
                RevisionDates(2, r) = ActiveSheet.Cells(current_row, "G")
                RevisionDates(3, r) = ActiveSheet.Cells(current_row, "H")
                r = r + 1
            End If
            current_row = current_row + 1
        Wend
End Sub
 
 
 
Sub RestoreData()
 
    For i = 1 To UBound(RevisionDates, 2)
        current_row = 5
        While ActiveSheet.Cells(current_row, "A") <> vbNullString
            If RevisionDates(1, i) = ActiveSheet.Cells(current_row, "A") Then
                ActiveSheet.Cells(current_row, "G").Value = RevisionDates(2, i)
                ActiveSheet.Cells(current_row, "H").Value = RevisionDates(3, i)
                current_row = 0
            End If
            current_row = current_row + 1
        Wend
    Next i
 
End Sub
 
 
Sub GetListing()
 
    SqlString = "Select id, name, document, block, page, receiptdate from table order by name, document, block, receiptdate"
 
    Dim QueryResults As ADODB.Recordset
    Set QueryResults = New ADODB.Recordset
    QueryResults.Open SqlString, CurrentConnection, adOpenDynamic, adLockReadOnly
 
    current_row = 5
    With QueryResults
        Do While Not QueryResults.EOF
            ActiveSheet.Cells(current_row, "A").Value = QueryResults.fields(0)
            ActiveSheet.Cells(current_row, "B").Value = QueryResults.fields(1)
            ActiveSheet.Cells(current_row, "C").Value = QueryResults.fields(2)
            ActiveSheet.Cells(current_row, "D").Value = QueryResults.fields(3)
            ActiveSheet.Cells(current_row, "E").Value = QueryResults.fields(4)
            ActiveSheet.Cells(current_row, "F").Value = QueryResults.fields(5)
            QueryResults.MoveNext
            current_row = current_row + 1
        Loop
    End With
 
    QueryResults.Close
End Sub