Message d'erreur sur code récup dernière cellule non vide

Ok.

Selon Microsoft cela peut venir du fait que les clés de registre n'existe pas (voir ici).

• Tape sur la touche windows + R
• Copie ça : Regsvr32.exe /U "C:\Program Files (x86)\Common Files\microsoft shared\DAO\Dao360.dll"
• Clique sur OK. Ça va désinstaller la dll Dao360.dll
• Tape à nouveau sur touche windows + R
• Copie ça : Regsvr32.exe "C:\Program Files (x86)\Common Files\microsoft shared\DAO\Dao360.dll"
• Clique sur OK. Ceci te réinstallera la dll

Malheureusement rien de changé.

Toujours le même message d'erreur.

C'est râlant car je suis sur que cela marche super bien sur ton poste.

jp65 a écrit :

Malheureusement rien de changé.

Toujours le même message d'erreur.

C'est râlant car je suis sur que cela marche super bien sur ton poste.

Oui environ 6s pour 128 fichiers

Par curiosité, quel est la version windows installée ?

Tu sembles avoir un problème d'installation des composants Microsoft Jet 4.0. Peut-être qu'il faut creuser par là...

Alors

Je suis sous Windows 64 version (malheureusement) 8.1 :

J'ai peur de ne pas avoir de solution... Je n'en ai pas non plus trouvé sur le net...

Attends une dernière tentative.

On utilise un autre fournisseur que Microsoft.Jet.OLEDB.4.0 : Microsoft.ACE.OLEDB.12.0 :

Sub ImporterDates2()
    Dim objShell As Object, objFolder As Object
    Dim Chemin As String, Fichier As String
    Dim wbkRecap As Workbook
    Dim cn As Object    'ADODB.Connection
    Dim rst As Object    'ADODB.Recordset
    Dim shtFile As String, strQuery As String
    Dim derlign As Long

    shtFile = "Sheet1"    'nom de l'onglet des différents fichiers
    Set objShell = CreateObject("Shell.Application")
    'Ouvre une fenêtre Window pour sélectionner le dossier
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
    'Si l'utilisateur annule sans choisir
    If objFolder Is Nothing Then
        'message
        MsgBox "Abandon opérateur", vbCritical, "Annulation"
        'sinon
    Else
        t = Timer
        Set wbkRecap = ThisWorkbook
        'Chemin = répertoire choisi
        Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
        'Choix du 1er fichier
        Fichier = Dir(Chemin & "*.xls")

        'spécification de la requête SQL de comptage
        'compte le nombre de lignes de la base
        strQuery = "SELECT COUNT(*) FROM [" & shtFile & "$]"

        'on boucle sur tous les fichiers excel du répertoire choisi
        Do While Len(Fichier) > 0
            If Fichier <> ThisWorkbook.Name Then

                Set cn = CreateObject("ADODB.Connection")    'late binding pour éviter l'activation de la référence ADO

                'initie la chaîne de connexion
                With cn
                    .Provider = "Microsoft.ACE.OLEDB.12.0"
                    .ConnectionString = "Data Source=" & Chemin & Fichier & _
                                        ";Extended Properties=Excel 12.0;"
                    .Open
                End With

                Set rst = cn.Execute(strQuery)
                'nombre de ligne à partir de la requête SQL prédéfinie
                derlign = rst.Fields(0).Value + 1

                'on vide les variables
                cn.Close
                Set rst = Nothing
                Set cn = Nothing

                With wbkRecap.Sheets("Feuil1")
                    'Inscrit le nom des fichiers en colonne A
                    .Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Fichier
                    'Inscrit le contenu de la cellule A3 en B
                    .Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = "='" & Chemin & "[" & Fichier & "]" & shtFile & "'!A3"
                    'Inscrit le contenu de la dernière ligne de la colonne A en C
                    .Range("C" & Rows.Count).End(xlUp).Offset(1, 0) = "='" & Chemin & "[" & Fichier & "]" & shtFile & "'!A" & derlign
                End With

            End If
            Fichier = Dir()
        Loop
    End If
    MsgBox Timer - t
End Sub

Bonjour

J'ai testé cette nouvelle macro et même punition et au même endroit

Par contre j'ai essayé tes deux dernières versions sur un autre PC et la tout fonctionne

à merveille et du premier coup .

J'ai bien un souci sur mon poste qui me bloque l'ouverture des classeurs.

Vba-new tu m'a accompagné avec beaucoup de patience et tu m'a donné beaucoup de conseils

qui de toute façon me seront utiles ainsi qu'à tous ceux qui ont lus ce post.

Tu as pleinement (et le mot est faible) répondu à ma demande initiale .

C'est pour celà que je clos le sujet.

Chapeau bas vba-new et merci pour tout