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.
 

jim7963

XLDnaute Junior
Bonjour Pierre

merci pour ta réponse, j'ai testé mais maintenant j'ai un nouveau message d'erreur: "Pilote ISAM introuvable".

J'ai fait une petite recherche rapide sur internet et je suis tombé sur: https://support.microsoft.com/fr-fr...ind-installable-isam-error-message-or-some-fi

J'ai essayé les manip indiquées pour lier les dll à la base de registre, ça a fonctionné mais le message d'erreur apparaît toujours.
 

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???
 

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
 

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...
 

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

Statistiques des forums

Discussions
311 731
Messages
2 081 993
Membres
101 856
dernier inscrit
Marina40