Doublons !

Question

Bonjour &#224; tous,

Voila j'ai un code VBA qui permet d'envoyer des donn&#233;es d'excel vers une table access. 
Cela fonctionne parfaitemement, le seul probl&#232;me que je rencontre est le suivant si j'envoie des donn&#233;es lorsque la table est vide il n'y a pas de probleme cela fonctionne. Si je rajoute une ligne au fichier excel et que je renvoie les donn&#233;es, la nouvelle ligne ne s'inscrit pas dans la table access, je pense que c parcequ'il touve des doublons ! 

j'ai un premier code celui de base et un second que j'ai essay&#233; d'am&#233;liorer...

Sub AjouterDesEnregistrementsAUneTable() 
Dim MyDB As Database, MyTable As Recordset, Sh As Worksheet 

Set MyDB =  OpenDatabase("S:\Qualit&#233;\BDD Qualit&#233;\BDD Qualit&#233;.mdb") 
Set MyTable = MyDB.OpenRecordset("produits") 
Set Sh = Worksheets("Feuil1") 

With Sh 
    For Each r In .Range("A5:C300").Rows 
        With MyTable 
            .AddNew 
            !sap = Sh.Cells(r.Row, 1) 
            !nom = Sh.Cells(r.Row, 2) 
            !prenom = Sh.Cells(r.Row, 3) 
            .Update 
        End With 
    Next 
End With Set MyDB Nothing: Set MyTable Nothing: Set Sh = Nothing 

End Sub

 Le second code am&#233;lior&#233; avec une conditionnel : 


Sub AjouterDesEnregistrementsAUneTable()

Dim test As Byte
Dim rs As Recordset
Dim MyDB As Database, MyTable As Recordset, Sh As Worksheet
test  = 0

Set MyDB = OpenDatabase("S:\Qualit&#233;\BDD Qualit&#233;\BDD Qualit&#233;.mdb")
Set MyTable = MyDB.OpenRecordset("produits")
Set Sh = Worksheets("Feuil1")

Set rs = "Select distinct sap from produits"

For Each r In .Range("A5:C300").Rows
Do While (rs.EOF False And test 0)
'Si la cl&#233; de ta ligne &#224; ajouter est deja utilis&#233;e alors on stop de comparerIf (rs!sap Sh.Cells(r.Row, 1)) Then test 1
Loop
'si la cl&#233; est non prise alors on ajoute
If (test = 0) Then
With MyTable
.AddNew
!sap = Sh.Cells(r.Row, 1)
!nom = Sh.Cells(r.Row, 2)
!prenom = Sh.Cells(r.Row, 3)
.Update
End With
End If
test = 0
Next

End Sub

j'ai une erreur qui me dit "erreur de compilation incompatibilit&#233; de type" 
je pense qu'il y a un probleme dans le code mais je sais pas ou car il me grise la ligne select ..from... et apres il me met en jaune "Sub AjouterDesEnregistrementsAUneTable()" 
Pouvez vous m'aider 

Merci beaucoup 

A+

cs_moustachu · Answer

Oui si rs est un recordset, Set rs = "Select distinct sap from produits" ne va pas. Tu dois ouvrir ton Recordset avec OpenRecordSet("Select distinct....")
++ Moustachu

lolo_bob2 · Answer

Ok 

je dois donc &#233;crire cela :

OpenRecordSet ("Select distinct sap from produits")

For Each r In .Range("A5:C300").Rows 
     Do While (rs.EOF False And test 0) 
         'Si la cl&#233; de ta ligne &#224; ajouter est deja utilis&#233;e alors on stop de comparer          If (rs!sap Sh.Cells(r.Row, 1)) Then test 1 
     Loop 
     'si la cl&#233; est non prise alors on ajoute 
     If (test = 0) Then 
        With MyTable 
            .AddNew 
            !sap = Sh.Cells(r.Row, 1) 
            !nom = Sh.Cells(r.Row, 2) 
            !prenom = Sh.Cells(r.Row, 3) 
            .Update 
        End With 
     End If 
     test = 0 
Next 

End Sub

Je vais faire le test 
merci beaucoup 
A+

Doublons !

2 réponses

Discussions similaires