ADODB encore une fois... SVP

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion nak
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
N

nak

XLDnaute Occasionnel
Bonjour à tous,

Décidément je n'arrive pas à utiliser la fonction ADO. 🙁

J'ai un premier fichier dans lequel je réalise mes enregistrements. Pour l'exemple j'ai utilisé les infos d'un participant quelconque. Je rempli ma ligne 6 de mon fichier un.xls, je clique sur le bouton, cela envoi les informations dans mon fichier base.xls.
Pour chaque numéro de participant je veux enregistrer à la suite.
Par contre si un numéro de participant est déjà existant j'aimerais que la ligne dans le fichier base.xls soit mise à jour.

Pouvez vous m'aider SVP car je n'arrive à rien...

Merci par avance.

A+
 

Pièces jointes

Trier par date Trier par votes
Re : ADODB encore une fois... SVP

Bonsoir Nak,

Voici le code qui te permettra de faire ce que tu souhaites
VB: 
Private Sub CommandButton1_Click()
    Dim Cn As ADODB.Connection
    Dim Cd As ADODB.Command
    Dim Rst As ADODB.Recordset
    Dim Fichier As String
    Dim VSearch As String
    Dim FlgFind As Boolean
    
    Fichier = ThisWorkbook.Path & "\base.xls"
        
    Set Cn = New ADODB.Connection
    Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & Fichier & ";" & _
        "Extended Properties=""Excel 8.0;HDR=No;"";"
    
    Set Cd = New ADODB.Command
    Cd.ActiveConnection = Cn
    ' Ouvrir 100 lignes d'enegistrement
    Cd.CommandText = "SELECT * FROM [Feuil1$A1:F100]"
    Set Rst = New ADODB.Recordset
    Rst.Open Cd, , adOpenKeyset, adLockOptimistic
    ' Se positionner sur le premier enregistrement
    Rst.MoveFirst
    ' Valeur à chercher, Flag de recherche
    VSearch = Range("A6"): FlgFind = False
    ' Effectuer une boucle pour trouver l'enregistrement correspondant
    Do While Not Rst.EOF
      ' Si la valeur du champ 1 est égal à la valeur cherchée
      If Rst(0).Value = VSearch Or Rst(0).Value = "" Then
        ' Met le flag de recherche à VRAI
        FlgFind = True
        ' Sort de la boucle
        Exit Do
      End If
      Rst.MoveNext
    Loop
    ' Si le flag de recherche est faux : aucun enregistrement trouvé
    ' On en créé un nouveau
    If FlgFind = False Then Rst.AddNew
    ' On rempli la ligne d'enregistrement avec les valeurs
    Rst(0).Value = Range("A6")
    Rst(1).Value = Range("B6")
    Rst(2).Value = Range("C6")
    Rst(3).Value = Range("D6")
    Rst(4).Value = Range("E6")
    Rst(5).Value = Range("F6")
    Rst.Update
    
    Cn.Close
    Set Cn = Nothing
    Set Cd = Nothing
    Set Rst = Nothing
End Sub

A+
 
Vote positif 0 Vote négatif
Re : ADODB encore une fois... SVP

Bonjour à tous,

Bruno, juste une chtite question: pourquoi ne pas rechercher directement un enregistrement existant plutôt que de parcourir le résultat de la requête, en utilisant une clause WHERE dans la requête par ex ?
 
Vote positif 0 Vote négatif
Re : ADODB encore une fois... SVP

Bonjour,

J'ai une petite question qui me trottine dans la tête. Avec les lignes suivantes je me contente de transférer six cellules. Si j'augmente significativement leurs nombres ma forme va devenir très longue.
Est-ce possible de transférer la ligne entière ou peux être plus simple les cellules A6:BZ6 ?

Merci

Rst(0).Value = Range("A6")
Rst(1).Value = Range("B6")
Rst(2).Value = Range("C6")
Rst(3).Value = Range("D6")
Rst(4).Value = Range("E6")
Rst(5).Value = Range("F6")
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
Re : ADODB encore une fois... SVP

Salut Jam
Jam à dit:
Bonjour à tous,
Bruno, juste une chtite question: pourquoi ne pas rechercher directement un enregistrement existant plutôt que de parcourir le résultat de la requête, en utilisant une clause WHERE dans la requête par ex ?
Cliquez pour agrandir...

En ADODB si tu as la soluce, je suis preneur 😉

A+
 
Vote positif 0 Vote négatif
Re : ADODB encore une fois... SVP

Salut nak,

nak à dit:
Bonjour,
J'ai une petite question qui me trottine dans la tête. Avec les lignes suivantes je me contente de transférer six cellules. Si j'augmente significativement leurs nombres ma forme va devenir très longue.
Est-ce possible de transférer la ligne entière ou peux être plus simple les cellules A6:BZ6 ?
Merci
Cliquez pour agrandir...

Jam à raison au sujet du parcour des enregistrements, mieux vaut utiliser un 'Find'
VB: 
Private Sub CommandButton1_Click()
  Dim Cn As ADODB.Connection
  Dim Cd As ADODB.Command
  Dim Rst As ADODB.Recordset
  Dim Fichier As String
  Dim VSearch As String, I As Integer
  ' Chemin d'accès de la base
  Fichier = ThisWorkbook.Path & "\base.xls"
  ' Créer la connexion
  Set Cn = New ADODB.Connection
  Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
          "Data Source=" & Fichier & ";" & _
          "Extended Properties=""Excel 8.0;HDR=No;"";"
  Set Cd = New ADODB.Command
  Cd.ActiveConnection = Cn
  ' Ouvrir 1000 lignes d'enegistrement
  Cd.CommandText = "SELECT * FROM [Feuil1$A1:F1000]"
  Set Rst = New ADODB.Recordset
  Rst.Open Cd, , adOpenKeyset, adLockOptimistic
  ' Chercher la valeur dans la BdD
  Rst.Find "F1 = '" & Range("A6") & "'", , adSearchForward, 1
  ' Si on se retrouve à la fin des enregistrement
  ' On en créé un nouveau
  If Rst.EOF = True Then Rst.AddNew
  ' On rempli la ligne d'enregistrement avec les valeurs
  For I = 0 To 5  ' Mettre ici le nombre de champs -1
    Rst(I).Value = Cells(6, 1 + I)
  Next I
  ' Metre à jour la ligne d'enregistrement
  Rst.Update
  ' Fermer la connexion
  Cn.Close
  ' Effacer les variables objet
  Set Cn = Nothing
  Set Cd = Nothing
  Set Rst = Nothing
End Sub

A+
 
Dernière modification par un modérateur:
Vote positif 0 Vote négatif
Re : ADODB encore une fois... SVP

Bruno,

Suis au taf et n'est pas trop le temps de regarder le code en détail. Néanmoins il est vrai que ma question n'était pas tout à fait juste. En fait il faut recherche l'enregistrement dans Base.xls via une clause WHERE. S'il existe on utilise effectue un UPDATE sinon un INSERT INTO (en SQL of course 🙂).

Dès que j'ai un peu de temps j'essaie d'écrire un bout de code.

Au fait, Nak, le code de Bruno fonctionnant très bien (et il est de plus très concis) je t'invite donc à l'utiliser. Il n'y a pas qu'une seule voie en programmation, ce qui fait d'ailleurs tout son charme !
 
Vote positif 0 Vote négatif
Re : ADODB encore une fois... SVP

Merci pour cette nouvelle formule 😉

J'ai essayé d'ajouter deux cellules mais j'ai une erreur. J'ai bien mis à -1 pour le I et 8 en nombre de cellules. Bizarre...
J'ai encore fait une erreur ?

Merci

For I = 0 To 7 ' Mettre ici le nombre de champs -1
Rst(I).Value = Cells(8, 1 + I)
Next I
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
Re : ADODB encore une fois... SVP

Bonsoir à tous,

Désolé de faire remonter le poste mais je n'arrive toujours pas à transférer plus de 6 colonnes... 🙁

J'ouvre de A1 à K1000, je fais un For I = 0 To 10 . Toujours l'erreur 3265...

Pouvez vous m'aider SVP ?

Merci

Private Sub CommandButton1_Click()
Dim Cn As ADODB.Connection
Dim Cd As ADODB.Command
Dim Rst As ADODB.Recordset
Dim Fichier As String
Dim VSearch As String, I As Integer
' Chemin d'accès de la base
Fichier = ThisWorkbook.Path & "\base.xls"
' Créer la connexion
Set Cn = New ADODB.Connection
Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Fichier & ";" & _
"Extended Properties=""Excel 8.0;HDR=No;"";"
Set Cd = New ADODB.Command
Cd.ActiveConnection = Cn
' Ouvrir 1000 lignes d'enegistrement
Cd.CommandText = "SELECT * FROM [Feuil1$A1:K1000]"
Set Rst = New ADODB.Recordset
Rst.Open Cd, , adOpenKeyset, adLockOptimistic
' Chercher la valeur dans la BdD
Rst.Find "F1 = '" & Range("A6") & "'", , adSearchForward, 1
' Si on se retrouve à la fin des enregistrement
' On en créé un nouveau
If Rst.EOF = True Then Rst.AddNew
' On rempli la ligne d'enregistrement avec les valeurs
For I = 0 To 10 ' Mettre ici le nombre de champs -1
Rst(I).Value = Cells(6, 1 + I)
Next I
' Metre à jour la ligne d'enregistrement
Rst.Update
' Fermer la connexion
Cn.Close
' Effacer les variables objet
Set Cn = Nothing
Set Cd = Nothing
Set Rst = Nothing
End Sub
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
Re : ADODB encore une fois... SVP

Bonsoir Bruno,

Le pire dans l'histoire c'est que je viens de trouver le problème après plusieurs semaines. Bon j'avoue ne pas avoir pensé à ce problème tous les jours 🙂

Cela vient du fichier base, il faut obligatoirement qu'il y ait des cellules renseignées (avec légendes par ex.) sur toute la longueur de la ligne importée.

Désolé d'avoir insisté sur un problème si simple.

Merci

A+
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

L
  • Question Question
XL 2016 Enregistrer une zone dans un PDF
Réponses
2
Affichages
395
patricktoulon
patricktoulon
M
  • Résolu(e)
XL 2016 Formule de ligne précédente non mise à jour après une insertion automatique de lignes dans l'objet tableau.
Réponses
4
Affichages
337
TooFatBoy
TooFatBoy
ARaul
  • Question Question
XL 2019 Copier et coller automatiquement une nouvelle donnée par un bouton, ListView décallée à la sur la page (Multipage) et vibration du Userform
2
Réponses
16
Affichages
977
TooFatBoy
TooFatBoy
V
  • Résolu(e)
XL 2019 Planning de réservation camping automatique
Réponses
5
Affichages
2 K
ValDorier
V
F
  • Question Question
Microsoft 365 Problème RECHERCHEV avec plusieurs correspondances possibles pour une même valeur
2
Réponses
15
Affichages
813
floflatch22
F
P
  • Résolu(e)
XL 2021 Requête API - VBA Excel - Parse JSON
Réponses
2
Affichages
909
picc
P
Droopyougo
  • Résolu(e)
Microsoft 365 Remplir une cellule avec la valeur d'une autre sous condition
Réponses
2
Affichages
598
Droopyougo
Droopyougo
C
  • Résolu(e)
XL 2021 Remplacer ThisWorkbook.Path par une cellule précise
Réponses
6
Affichages
624
cgpa
C
D
  • Résolu(e)
Microsoft 365 Macro pour rafraîchir les liaisons
Réponses
11
Affichages
828
AtTheOne
AtTheOne
B
  • Question Question
XL 2021 Transfert tableau structuré EXCEL à un endroit précis de WORD
Réponses
8
Affichages
1 K
job75
job75
Todre
  • Résolu(e)
Microsoft 365 Remplissage automatique d'une feuille à l'autre
2 3 4
Réponses
58
Affichages
4 K
MALKO
M
A
  • Question Question
XL pour MAC Peut on mettre plusieurs données de différentes lignes sur une seule ?
Réponses
5
Affichages
1 K
chris
chris
L
  • Question Question
Microsoft 365 Faire agir une macro en fonction de l'emplacement du bouton
Réponses
2
Affichages
660
AtTheOne
AtTheOne
C
  • Question Question
XL 2021 case à cocher dans ListView impacte une cellule de feuille
Réponses
1
Affichages
1 K
fanch55
fanch55
E
  • Résolu(e)
Microsoft 365 Boucle Checkbox ActiveX + Report dans TextBox
Réponses
5
Affichages
804
ExcLnoob
E
G
  • Question Question
Microsoft 365 Saut de ligne dans une cellule
Réponses
3
Affichages
880
GClaire
G
J
  • Question Question
XL 2019 Calculer une différence de temps théorique avec le temps réel
Réponses
4
Affichages
631
goube
goube
C
  • Question Question
Microsoft 365 Comment modifier une partie d'une formule utilisé plusieurs fois ?
Réponses
10
Affichages
946
Croc_de_loups
C
J
  • Question Question
Microsoft 365 Plusieurs lignes à regrouper sur une seule
Réponses
2
Affichages
755
Juninho Ood
J
A
  • Résolu(e)
Microsoft 365 Formule indirect?
Réponses
4
Affichages
785
AlexiaC
A
Retour