Discussion :

[Aleexx]

Bonjour à tous

Je dispose de données dans un fichier Excel. Sur ce fichier, j'ai codé un bouton en VBA permettant de transférer les données du tableau Excel dans les champs correspondant dans ma table Access.
Mon problème est le suivant: le tableau Excel est mis à jour régulièrement. Avec mon code actuel, quand j'appuis sur le bouton, il additionne les enregistrements dans la table.

Sachant que la valeur "toto" ne change pas. J'aimerai lorsque qu'il détecte à partir de la 2ème fois la même valeur "toto", qu'il remplace les valeurs des autres champs dans ma table Access.


Merci d'avance


Voici mon code actuel pour exporter mon tableau Excel :

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
For r = 2 To Selection.SpecialCells(xlCellTypeLastCell).Row
    ' Réalise la boucle jusqu'à la dernière cellule de la plage utilisé
 
       If Range("A" & r) & "" = "" Then
           Exit For 'Sort si la 1ère colonne est vide
       End If
 
 
          With rs
 
            .AddNew ' Crée un nouvel enregistrement
            ' Renseigne les valeurs des champs
            .Fields("toto") = Range("A" & r).Value
            .Fields("truc") = Range("C" & r).Value
            .Fields("titi") = Range("D" & r).Value
            .Fields("machin") = Range("F" & r).Value
 
 
            .Update ' MAJ du nouvel enregistrement
          End With
 
 
Next r  'fin de la boucle For

[marot_r]

Bonjour.

À mettre avant la boucle

Code :

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

dim critere as string

À mettre dans la boucle

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
with rs
   critere="[Toto]=""" & Range("A" & r).Value & """" 'Suppose que Toto est un champ texte
 
   call .findfisrt(critere)
 
   if .nomatch() then
       rs.addnew
    else
       rs.update
   end if
 
   ' Renseigne les valeurs des champs
   .Fields("toto") = Range("A" & r).Value
   .Fields("truc") = Range("C" & r).Value
   .Fields("titi") = Range("D" & r).Value
   .Fields("machin") = Range("F" & r).Value
 
   .Update ' MAJ du nouvel enregistrement
end With

Si cela génère une erreur du genre "Trop de locks", la seule méthode simple que j'ai trouvée c'est de fermer puis de rouvrir le recordset dans la boucle, environ tous les 5000 enregistrements.
C'est un peu dégueu mais cela marche sans presque ralentir le traitement.

A+

[Aleexx]

Bonjour marot,

Merci de ta réponse. Malheureusement, Je n'arrive pas à le faire fonctionner.
Quand je l'exécute, il me met : "membre de méthode ou de données introuvable" pour cette ligne :

Code :

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

call .findfisrt(critere)

Après quelque cherche il faut apparemment décocher les références à DAO
Si je décoche : Microsoft ActiveX Data Objects 2.0 Library, cette fois -ci c'est mon ADODB.Connection qui ne fonctionne pas.

Comment faire

[marot_r]

Erreur de frappe ... désolé.

Code :

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

.findfirst(critere)

A+

[Aleexx]

Oui effectivement j'avais corrigé aussi cette erreur. Mais cela ne fonctionne toujours pas

[micniv]

Bonjour,
désormais il faut être explicite dans les déclarations :
as-tu bien typé '... as DAO.database' pour la db
et ' ... as DAO.recordset' pour le rs ?

CDLT

[Aleexx]

Bonjour micniv,

Voici comment j'ai déclaré mes déclarations :

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
Dim Cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim r As Long
    Dim critere As String
 
    ' Connexion à la base Access
 
    Set Cn = New ADODB.Connection
 
    Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & "Data Source=C:\Users\xxxxxxx.accdb"
 
    ' Ouvre un recordset
 
    Set rs = New ADODB.Recordset
 
    rs.Open "xxx", Cn, adOpenKeyset, adLockOptimistic, adCmdTable

[Aleexx]

Pour ne pas avoir d'erreur de compilation avec ADODB, j'ai remplacé

cette ligne :

Code :

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

call .findfirst(critere)

par celle-ci :

Code :

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

rs.Find (critere), , adSearchForward

et cette ligne :

Code :

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

if .nomatch() then

par celle-ci :

Code :

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

If rs.BOF Or rs.EOF Then

Quand j'appuie mon bouton, il additionne les enregistrements, mais il ne les remplace toujours pas