Comparer les noms de fichiers dans un dossier avec ceux dans une feuille ex

Le 22/06/2018 à 14:52

Bonjour à tous,

je cherche à comparer les noms de fichiers excel se trouvant dans un dossier avec des noms récupérés dans un fichier

Dis comme ça, pas sur d'être compris.

Mon code vba actuel :

Sub RequeteClasseurFerme()
    Dim Cn As ADODB.Connection
    Dim Dossier As String, Fichier As String, texte_SQL As String
    Dim Rst As ADODB.Recordset
    Dim wb As Workbook

    'Définit le classeur fermé servant de base de données
    Dossier = "Y:\Mes documents\00 - bureau\semaine\"
    Fichier = Dir(Dossier & "*.xlsx")

    Set Cn = New ADODB.Connection
    Set wb = ThisWorkbook

    '--- Connection ---
        With Cn
            .Provider = "Microsoft.Jet.OLEDB.4.0"
            .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
                & Dossier & Fichier & ";Extended Properties=""Excel 12.0;HDR=NO;"""
            .Open
        End With
    '-----------------

        Do While Len(Fichier) > 0

        'je récupère le nom du fichier
                wb.Sheets(1).Range("C60000").End(xlUp).Offset(1, -2).Value = Fichier

        'On sélectionne l'ensemble du tableau EXPORT_NORMAL
                texte_SQL = "SELECT * FROM EXPORT_NORMAL"

                Set Rst = New ADODB.Recordset
                Set Rst = Cn.Execute(texte_SQL)

        'Ecrit le résultat
                wb.Sheets(1).Range("B60000").End(xlUp).Offset(0, 0).CopyFromRecordset Rst

                Fichier = Dir

        Loop

        '--- Fermeture connexion ---
        Cn.Close
        Set Cn = Nothing

        MsgBox "C'est terminé !"
End Sub

Donc, je vais récupérer un tableau dans chaque fichier excel qui se trouve dans le dossier Y:\Mes documents\00 - bureau\semaine\

Par la même occasion, je récupère le nom du fichier et je colle tout ça sur ma Feuil1.

Dans ce dossier, il y a régulièrement de nouveaux fichiers excel qui apparaissent.

Ma question : comment faire pour récupérer les données des nouveaux fichiers ?

Je pensais comparer les noms (vu que je les récupère) mais je ne m'en sors absolument pas

Dans ma tête, c'est tout simple mais quand je veux le coder, je tourne en rond sans vraiment réussir.

Quelqu'un pourrait-il me dépanner SVP ?

Le 22/06/2018 à 20:56

Bonjour,

Avec FSO (File System Object) je l'ai intégré dans ton code mais absolument pas testé. Les dates concernant le fichier en cours sont inscrites en colonne A sous le nom du fichier pour le test. Tu peux les inscrire ailleurs et faire les comparaisons avant la récup des valeurs :

Sub RequeteClasseurFerme()

    Dim Fso As Object
    Dim F As Object

    Dim Cn As ADODB.Connection
    Dim Dossier As String, Fichier As String, texte_SQL As String
    Dim Rst As ADODB.Recordset
    Dim wb As Workbook
    Dim Lig As Long

    'Définit le classeur fermé servant de base de données
    Dossier = "Y:\Mes documents\00 - bureau\semaine\"
    Fichier = Dir(Dossier & "*.xlsx")

'$$$$$$$$$$$$$$$$$$$$$$$ ICI !
    Set Fso = CreateObject("Scripting.FileSystemObject")
'$$$$$$$$$$$$$$$$$$$$$$$

    Set Cn = New ADODB.Connection
    Set wb = ThisWorkbook

    '--- Connection ---
    With Cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
            & Dossier & Fichier & ";Extended Properties=""Excel 12.0;HDR=NO;"""
        .Open
    End With
    '-----------------

    Do While Len(Fichier) > 0

        'je récupère le nom du fichier
        'wb.Sheets(1).Range("C60000").End(xlUp).Offset(1, -2).Value = Fichier

'$$$$$$$$$$$$$$$$$$$$$$$ ICI !
        With wb.Sheets(1)

            Lig = .Cells(.Rows.Count, 3).End(xlUp).Row + 1

            .Cells(Lig, 1).Value = Fichier 'le nom du fichier

            Set F = Fso.GetFile(Dossier & Fichier)

            .Cells(Lig + 1, 1).Value = F.DateCreated 'la date de création
            .Cells(Lig + 2, 1).Value F.DateLastModified 'la date de dernière modification
            .Cells(Lig + 3, 1).Value F.DateLastAccessed 'la date du dernier accès

        End With
'$$$$$$$$$$$$$$$$$$$$$$$

        'On sélectionne l'ensemble du tableau EXPORT_NORMAL
        texte_SQL = "SELECT * FROM EXPORT_NORMAL"

        Set Rst = New ADODB.Recordset
        Set Rst = Cn.Execute(texte_SQL)

        'Ecrit le résultat
        wb.Sheets(1).Range("B60000").End(xlUp).Offset(0, 0).CopyFromRecordset Rst

        Fichier = Dir

    Loop

        '--- Fermeture connexion ---
    Cn.Close
    Set Cn = Nothing

    MsgBox "C'est terminé !"

End Sub

Sinon, un code pour te donner une piste :

Sub Recup()

    Dim Fso As Object
    Dim F As Object
    Dim Dossier As String
    Dim Fichier As Variant

    Dossier = "Y:\Mes documents\00 - bureau\semaine\"
    Fichier = Dir(Dossier & "*.xlsx")

    Set Fso = CreateObject("Scripting.FileSystemObject")

    If Fso.FileExists(Dossier & Fichier) = True Then

        Set F = Fso.GetFile(Dossier & Fichier)

        Range("A1") = "Chemin"
        Range("A2") = "Nom du fichier"
        Range("A3") = "Date de création"
        Range("A4") = "Dernière modification"
        Range("A5") = "Dernier Accès"
        Range("A6") = "Taille (en Kilo Octets)"
        Range("A7") = "Type de fichier"

        Range("B1") = Left(F.Path, InStrRev(F.Path, "\"))
        Range("B2") = Dir(F.Path)
        Range("B3") = F.DateCreated
        Range("B4") = F.DateLastModified
        Range("B5") = F.DateLastAccessed
        Range("B6") = Round(F.Size / 1024, 0)
        Range("B7") = F.Type

    End If

End Sub
Le 25/06/2018 à 10:06

merci beaucoup pour ta réponse, je vais regarder ça dans la semaine

Le 25/06/2018 à 11:13

Je savais bien que ce que je voulais faire était tout bête mais la semaine dernière, pas moyen de m'en sortir.

Je n'ai absolument pas utilisé ce que tu m'as dit mais c'est toi qui m'a mis sur la piste Donc merci beaucoup pour l'aide involontaire 

Sub RequeteClasseurFerme()
    Dim Cn As ADODB.Connection
    Dim Dossier As String, Fichier As String, texte_SQL As String
    Dim Rst As ADODB.Recordset
    Dim wb As Workbook
    Dim i As Integer

    Application.ScreenUpdating = False

    'Définit le classeur fermé servant de base de données
    Dossier = "Y:\Mes documents\00 - bureau\semaine\"
    Fichier = Dir(Dossier & "*.xlsx")

    Set Cn = New ADODB.Connection
    Set wb = ThisWorkbook

        '___init var i à 2 pour avoir cellule A2 sheet 2 en 1er.
        i = 2

    '--- Connection ---
        With Cn
            .Provider = "Microsoft.Jet.OLEDB.4.0"
            .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
                & Dossier & Fichier & ";Extended Properties=""Excel 12.0;HDR=NO;"""
            .Open
        End With
    '-----------------

        Do While Len(Fichier) > 0

                FichierExtrac = Sheets(2).Range("A" & i).Value

                '____on compare les noms de fichier. Si déjà existant, on saute la copie pour refaire une boucle avec le fichier suivant
                If Fichier = FichierExtrac Then GoTo suite

                '____si les 2 ne sont pas égaux, on récupère les données du tableau et on copie le nom du fichier en sheet 2 pour future comparaison

                wb.Sheets(1).Range("C60000").End(xlUp).Offset(1, -2).Value = Fichier
                wb.Sheets(2).Range("A60000").End(xlUp).Offset(1, 0).Value = Fichier

        'On sélectionne l'ensemble du tableau EXPORT_NORMAL
                texte_SQL = "SELECT * FROM EXPORT_NORMAL"

                Set Rst = New ADODB.Recordset
                Set Rst = Cn.Execute(texte_SQL)

        'Ecrit le résultat
                wb.Sheets(1).Range("B60000").End(xlUp).Offset(0, 0).CopyFromRecordset Rst

        '____Comparaison noms fichiers. Si les 2 noms sont =, on saute ici pour passer au fichier suivant et on incrémente la var i
suite:
                Fichier = Dir
                i = i + 1

        Loop

        '--- Fermeture connexion ---
        Cn.Close
        Set Cn = Nothing

        Application.ScreenUpdating = True

        MsgBox "C'est terminé !"
End Sub
Le 25/06/2018 à 18:09

Bonjour,

Bien content de t'avoir mis sur la piste !

Rechercher des sujets similaires à "comparer noms fichiers dossier ceux feuille"