Enregistrer plusieurs lignes dans un fichier fermé

[nak]

Bonjour,

J'essai de porter la fonction ADODB dans un classeur Excel 2007.
Si j'arrive à un bon résultat sur Excel 2003, cette version 2007 me pose des problèmes.

J'ai deux fichiers, un pour la base, l'autre pour réaliser des saisies.
Dans mon fichier saisie une ligne correspond à une action, sur un produit (colonne B) et sur un ordre de fabrication (colonne C). Il peut y avoir plusieurs saisies sur un même produit et sur un même OF. C'est pour cette raison que j'ai choisi de concaténer les infos en colonne A de façon à créer un numéro d'identifiant.

La fonction recherchée, lorsque j’appuie sur le bouton enregistrement chaque ID est créé ou mis à jour dans la base.
Voici le code :

Sub EnregistrementBase()
    Dim Cn As ADODB.Connection
    Dim Fichier As String
    Dim NomFeuille As String, texte_SQL As String
    Dim Rst As ADODB.Recordset
    Dim DernLigne As Long
    
    'Définit le classeur fermé servant de base de données
    Fichier = ThisWorkbook.Path & "\base.xlsx"
    'Nom de la feuille dans le classeur fermé
    NomFeuille = "Feuil1"
    
    Set Cn = New ADODB.Connection
    
    '--- Connexion ---
    With Cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
            & Fichier & ";Extended Properties=""Excel 12.0;HDR=YES;"""
        .Open
    End With
    '-----------------
    '... la requête ...
    '
    ' Ouvrir 1000 lignes d'enegistrement
    Cd.CommandText = "SELECT * FROM [Feuil1$A1:T1000]"
    Set Rst = New ADODB.Recordset
    Rst.Open Cd, , adOpenKeyset, adLockOptimistic
    'Boucler sur plusieurs lignes
    DernLigne = Range("A" & Rows.Count).End(xlUp).Row
    For L = 11 To DernLigne
    ' Chercher la valeur dans la BdD
    Rst.Find "F1 = '" & Range("A" & L & ")" & "'", , 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 19 ' Mettre ici le nombre de champs -1
    Rst(I).Value = Cells(L, 1 + I)
    Next I
    Next L
    ' 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
    
    '--- Fermeture connexion ---
    Cn.Close
    Set Cn = Nothing

End Sub

Malheureusement cela bloque dans le Rst.Find
Avez-vous une idée pour me dépanner ?

A noter, qu'ensuite je vais essayer de faire la fonction inverse. C'est à dire importer les données par rapport à l'OF saisie.

Merci d'avance pour votre aide.

A+

 

[_Thierry]

Re : Enregistrer plusieurs lignes dans un fichier fermé

Bonsoir

J'ai eu à reprendre aussi des développements que j'avais fait en ADO avec Excel 2003...

Je me suis rendu compte que le Provider = "Microsoft.Jet.OLEDB.4.0" était devenu obsolète avec Win 7 et Office 2010 (et 2007)

https://www.excel-downloads.com/threads/vba-macro-copier-coller-plage-non-vide.41309/

Dans ce fil tu trouveras de quoi faire pour ADO et ADODB, je n'ai pas approfondi pour ADODB en écriture, mais je l'utilise en Select dans le fichier joint dans mon post.

Tiens nous au courant

Bonne Soirée
@+Thierry

 

[ChTi160]

Re : Enregistrer plusieurs lignes dans un fichier fermé

Bonjour nak
Bonjour le Fil

Arffffffffffffffffff je ne peux résister au plaisir de Saluer @+Thierry

j’espère que tu vas Bien .
Bonne Journée
Amicalement
Jean Marie

 

[nak]

Re : Enregistrer plusieurs lignes dans un fichier fermé

Bonjour,

J'ai modifier le mode de connexion. J'ai également fait évoluer mon code Rst.Find.
Maintenant j'obtiens une erreur 424... Je suis sous Windows 2008 et Office 2007.

Sub EnregistrementBase()
    Dim Cn As ADODB.Connection
    Dim Fichier As String
    Dim NomFeuille As String, texte_SQL As String
    Dim Rst As ADODB.Recordset
    Dim DernLigne As Long
    
    'Définit le classeur fermé servant de base de données
    Fichier = ThisWorkbook.Path & "\base.xlsx"
    'Nom de la feuille dans le classeur fermé
    NomFeuille = "Feuil1"
    
    Set Cn = New ADODB.Connection
    
    '--- Connexion ---
    With Cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
        & ArgFullPath & ";" & "Extended Properties=""Excel 12.0 Xml;HDR=No;"";"
    End With
    '-----------------
    '... la requête ...
    '
    ' Ouvrir 1000 lignes d'enegistrement
    Cd.CommandText = "SELECT * FROM [Feuil1$A1:T1000]"
    Set Rst = New ADODB.Recordset
    Rst.Open Cd, , adOpenKeyset, adLockOptimistic
    'Boucler sur plusieurs lignes
    DernLigne = Range("A" & Rows.Count).End(xlUp).Row
    For L = 11 To DernLigne
    ' Chercher la valeur dans la BdD
    Rst.Find "F1 = '" & Cells(L, 1) & "'", , 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 19 ' Mettre ici le nombre de champs -1
    Rst(I).Value = Cells(L, 1 + I)
    Next I
    Next L
    ' 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
    
    '--- Fermeture connexion ---
    Cn.Close
    Set Cn = Nothing

End Sub

Une idée SVP ?

Merci

 

[nak]

Re : Enregistrer plusieurs lignes dans un fichier fermé

Pour vérifier mon code je suis passé sur du 2003 (XLS).
Ça fonctionne presque, seul problème l'enregistrement se fait sur "n'importe quelle ligne" au lieu de la première ligne vide. Avez-vous une idée ?

Version pour 2003

Sub Fermer_et_sauvegarder()
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
DernLigne = Range("A" & Rows.Count).End(xlUp).Row

' 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:T65000]"
Set Rst = New ADODB.Recordset
Rst.Open Cd, , adOpenKeyset, adLockOptimistic

'Boucler sur plusieurs lignes

For L = 11 To DernLigne

' Chercher la valeur dans la BdD
Rst.Find "F1 = '" & Cells(L, 1) & "'", , 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 19 ' Mettre ici le nombre de champs -1
    Rst(i).Value = Sheets("Feuil1").Cells(L, 1 + i)
    Next i

Next L

' 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

Pour 2007, en XLSX, ça ne veut pas fonctionner...

Je vous joins les fichiers à jour.

Merci