XL 2013 Connexion ADODB ne foncitonne plus

jim7963

XLDnaute Junior
Bonjour à tous,

voici un morceau de code que j'utilisais jusqu'à présent et qui fonctionnait très bien. Il me permet de récupérer les données de plusieurs fichiers fermés excel au format xls.

Code:
Dim Source As ADODB.Connection
Dim Rst As ADODB.Recordset
Dim ADOCommand As ADODB.Command
Dim Fichier As String, Cellule As String, Feuille As String
Dim tabloEtats As Variant, tabloEtats2 As Variant, numEtat As Integer

Feuille = "A$"
Cellule = "A1:AA100"

tabloEtats = Array("Etat des charges mensuel", "Salaires cumulés", "Salaires mensuels", "Taxes sociales cumul", "Taxes sociales mensuelles", "Frais de perso Pilote")

For numEtat = LBound(tabloEtats) To UBound(tabloEtats)
   
        Fichier = ThisWorkbook.Path & "\Données\" & tabloEtats(numEtat) & ".xls"
        Sheets(tabloEtats(numEtat)).Cells.ClearContents

        Set Source = New ADODB.Connection
        With Source
            .Provider = "Provider=Microsoft.Jet.OLEDB.4.0"
            .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Fichier & ";Extended Properties=""Excel 12.0;HDR=No;"""
            .Open
        End With
        Set ADOCommand = New ADODB.Command

        With ADOCommand
            .ActiveConnection = Source
            .CommandText = "SELECT * FROM [" & Feuille & Cellule & "]"
        End With

        Set Rst = New ADODB.Recordset
        Rst.Open ADOCommand, , adOpenKeyset, adLockOptimistic
        Set Rst = Source.Execute("[" & Feuille & Cellule & "]")

            Sheets(tabloEtats(numEtat)).Cells(1, 1).CopyFromRecordset Rst
                Rst.Close
                Source.Close
                Set Source = Nothing
                Set Rst = Nothing
                Set ADOCommand = Nothing

Next numEtat
Mon problème est qu'aujourd'hui, les données que je récupère ne sont plus dans des fichiers xls mais dans des fichiers xlsx.

Quand je modifie la ligne:
Code:
Fichier = ThisWorkbook.Path & "\Données\" & tabloEtats(numEtat) & ".xls"
par

Code:
Fichier = ThisWorkbook.Path & "\Données\" & tabloEtats(numEtat) & ".xlsx"
Il me met un message d'erreur à la ligne
Code:
.open
Erreur d'execution '-2147467259 (80004005)':
La table externe n'est pas dans le format attendu.

Or d'après mes recherches ce code permet bien d'ouvrir les fichiers xlsx.

Quelqu'un saurait-il une solution à ce problème?

En vous remerciant par avance.
 

tatiak

XLDnaute Barbatruc
Bonjour,
Change de driver :
VB:
Set Source = New ADODB.Connection
Source.Provider = "MSDASQL"
Source.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)}; DBQ=" & Fichier & "; ReadOnly=False;"
Pierre
 

jim7963

XLDnaute Junior

tatiak

XLDnaute Barbatruc
En relisant ton code, il y a beaucoup d'éléments qui me chiffonnent :

- utiliser 2 providers (jet puis ACE) c'est inutile, un seul suffit et MSDASQL convient bien ici.

- Feuille = "A$" => il y a bien une feuille nommée "A"?

- Source.Execute => pour un Select c'est inutile Open suffit pour récupérer ton recordset

- ADOCommand => je ne vois pas l'utilité

- tu indiquais que les fichiers sont en xlsx

Voici une proposition à tester :
VB:
Dim Source As Object, Rst As Object
Dim Requete As String
Dim Fichier As String, Feuille As String, Cellule As String
Dim tabloEtats As Variant, numEtat As Integer

    Feuille = "A$"
    Cellule = "A1:AA100"
    tabloEtats = Array("Etat des charges mensuel", "Salaires cumulés", "Salaires mensuels", "Taxes sociales cumul", "Taxes sociales mensuelles", "Frais de perso Pilote")

    For numEtat = LBound(tabloEtats) To UBound(tabloEtats)
        Fichier = ThisWorkbook.Path & "\Données\" & tabloEtats(numEtat) & ".xlsx"
        Sheets(tabloEtats(numEtat)).Cells.ClearContents
        Set Source = CreateObject("ADODB.Connection")
        Source.Provider = "MSDASQL"
        Source.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)}; DBQ=" & Fichier & "; ReadOnly=False;"
        Set Rst = CreateObject("ADODB.Recordset")
        Requete = "SELECT * FROM [" & Feuille & Cellule & "]"
        Rst.Open Requete, Source, 3
        Sheets(tabloEtats(numEtat)).Cells(1, 1).CopyFromRecordset Rst
        Source.Close
        Set Source = Nothing
        Set Rst = Nothing
    Next numEtat
 
Dernière édition:

jim7963

XLDnaute Junior
Bonjour,

merci pour la réponse et toutes mes excuses pour le retour tardif.
Je n'ai pas eu le temps de me re-pencher sur ce fichier depuis la semaine dernière.

Pour le code ADODB j'avais pris un modèle tout fait que j'avais récupéré sur un autre site et qui fonctionnait bien jusqu'à maintenant. J'avoue que ce n'est pas une partie du codage que je maîtrise.

Pour répondre à ta question, oui chaque fichier ne contient qu'une seule feuille appelée "A".

Quand je teste ton code, j'ai un retour d'erreur à la ligne:
Code:
Source.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)}; DBQ=" & Fichier & "; ReadOnly=False;"
qui me dit:
"Erreur d'execution '-2147467259 (80004005)':
[Microsoft][Pilote ODBC Excel]Erreur générale Impossible d'ouvrir la clé de registre "Temporary (volatile) Ace DSN for process 0x27f8Thread 0xf2c DBC 0x16e 17fdc Excel".

Bref comme d'habitude message d'erreur très clair. La seule chose que je crois comprendre c'est qu'il me manquerait un clé dans l'éditeur de registre mais quoi???
 

tatiak

XLDnaute Barbatruc
Bonjour,
Je ne pense pas qu'il soit nécessaire de bidouiller dans le registre.

2 tests à faire :
1/ On peut commencer par vérifier que les fichiers sont bien trouvés :
VB:
sub Test()
Dim Fichier As String, Feuille As String, Cellule As String
Dim tabloEtats As Variant, numEtat As Integer

    tabloEtats = Array("Etat des charges mensuel", "Salaires cumulés", "Salaires mensuels", "Taxes sociales cumul", "Taxes sociales mensuelles", "Frais de perso Pilote")

    For numEtat = LBound(tabloEtats) To UBound(tabloEtats)
        Fichier = ThisWorkbook.Path & "\Données\" & tabloEtats(numEtat) & ".xlsx"
        If not Exist_Fichier then Msgbox Fichier & " n'existe pas" else debug.print Fichier
    Next numEtat
end sub


Function Exist_Fichier(S As String) As Boolean
Dim tatiak As Object

    Set tatiak = CreateObject("Scripting.FileSystemObject")
    Exist_Fichier = tatiak.FileExists(S)
    Set tatiak = Nothing
End Function
2/ On peut voir si sur ton PC le code de la dernière démo du fil suivant fonctionne bien =>
https://www.excel-downloads.com/threads/écrire-dans-classeur-fermé-plage-de-cellule-ado.20028355/
(c'est du code qui utilise la même méthode)

Tiens-nous au courant
Pierre
 

jim7963

XLDnaute Junior
Merci pour ta réponse.

Pour le 1er test, oui les fichiers existent bien et le code les trouve.

Pour le 2nd test, j'ai bien pris la dernière démo du fil et j'ai intégré le code dans le mien ce qui donne :
Code:
        Set Source = CreateObject("ADODB.Connection")
            Source.Provider = "MSDASQL"
            Source.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" & "DBQ=" & Fichier & "; ReadOnly=False;"
J'ai toujours une erreur en retour au niveau de la ligne de l'open où il me dit que la table externe n'est pas dans le format attendu. Or je fais bien appel à des fichiers .xlsx
 

tatiak

XLDnaute Barbatruc
Ok, donc si la démo fonctionne sur ton PC,je confirme :
* inutile de bidouiller dans la base de registre
* le provider est correct

Ensuite si les fichiers sont bien trouvés avec la procédure "Test" ci-dessus, avec chacun un onglet "A" et si l'erreur vient de l'open, c'est qu'il faut effectivement voir du côté de la structure des fichiers.

Pour continuer à t'aider, ce serait idéal de pouvoir voir un de tes fichiers (bien sûr anonymisé et vidé des données "sensibles") (on aurait peut être pu commencer par ça d'ailleurs)

Pierre
 

jim7963

XLDnaute Junior
Je n'y comprend plus rien, j'ai ouvert les fichiers pour anonymiser et j'ai refais un test par acquis de conscience avec ton code et maintenant ça marche.....
Je deviens fou.

Par contre une dernière question, avec ton code il ne me reprend pas la 1ère ligne d'en-tête.
Avec mon code je pouvais le définir avec la commande HDR=Yes, mais avec le tien je ne sais pas comment faire.
 

jim7963

XLDnaute Junior
Bon après re-test, quand j'exporte mon fichier de données ça me remet l'erreur.
Par contre quand je fais une modif dans le fichier de données (même en la supprimant de suite) et que je ré-enregistre le fichier là l'erreur ne se produit plus.

Va comprendre...
 

tatiak

XLDnaute Barbatruc
C'est curieux en effet.
Si le xlsx est généré par un logiciel tiers, il se peut qu'il y ait une particularité qui n'est pas bien reconnue par Excel/ADO (d'où la meilleure lecture après modif dans excel). Ce n'est qu'une hypothèse.

Pour la ligne d'entête, il suffit d'ajouter quelques lignes (après avoir déclaré un Dim i as integer) :

VB:
        ' ...
        Requete = "SELECT * FROM [" & Feuille & Cellule & "]"
        Rst.Open Requete, Source, 3
        With Sheets(tabloEtats(numEtat))
            For i = 1 To Rst.Fields.Count
                .Cells(1, i).Value = .Rst.Fields(j - 1).Name
            Next i
            .Cells(2, 1).CopyFromRecordset Rst
        End With
        Source.Close
        '...
(rq: le recordset est collé à partir de la ligne 2)

Pierre
 

job75

XLDnaute Barbatruc
Bonsoir jim7963, tatiak,

Quand c'est possible il est plus simple d'utiliser des formules de liaison :
Code:
Sub Copie()
Dim chemin$, feuil$, plage$, plageR1C1$, e
chemin = ThisWorkbook.Path & "\Données\" 'à adapter
feuil = "A"
plage = "A1:AA100"
plageR1C1 = Application.ConvertFormula(plage, xlA1, xlR1C1, ToAbsolute:=True)
Application.ScreenUpdating = False
For Each e In Array("Etat des charges mensuel", "Salaires cumulés", "Salaires mensuels", "Taxes sociales cumul", "Taxes sociales mensuelles", "Frais de perso Pilote")
    With Sheets(e).Range(plage)
        .FormulaArray = "='" & chemin & "[" & e & ".xlsx]" & feuil & "'!" & plageR1C1 'formule matricielle
        .Value = .Value 'supprime les formules de liaison
        .Replace 0, "", xlWhole 'supprime les valeurs zéro
        With .Parent.UsedRange: End With 'actualise les barres de défilement
    End With
Next
End Sub
Chez moi sur Win 10 - Excel 2013 la macro s'exécute en 0,22 seconde (plages pleines) et 0,35 seconde (plages vides).

A+
 

Discussions similaires


Haut Bas