Récupération de valeurs dans fichiers/sous-dossiers

Salut,

Bien qu' il y ait des sujets qui traitent de cela, je ne suis pas arrivé a obtenir quelque chose de propre au niveau de mon code car j'ai repris plusieurs partie de code existant et là je suis perdu... je ne touche d'habitude pas au VBA donc dur de tout comprendre.

En fait je voudrais lister dans un fichier:

En colonne A: tous les fichiers excel d'un dossier (et de ses sous dossiers)

En colonne B: la date de création de ces fichiers

En colonne C: la valeur de la cellule "C30" de ces fichiers

Sachant que le fichier se trouvera dans le même répertoire.

Une âme charitable pourrait me proposer un petit truc ?

Merci

Bonsoir, je propose pas une macro toute faite mais un lien vers un exemple qui vous sera très utile

https://vbaforexcel.wordpress.com/2013/09/06/lister-les-fichiers-et-sous-dossiers-dun-dossier/

bonsoir,

proposition de solution à mettre dans un module

Dim nr

Sub test()
    nr = 0
    browsefolder ("f:\")
End Sub
Sub browsefolder(Optional chemin)
    Set cws = ThisWorkbook.ActiveSheet
    If chemin = "" Then chemin = ThisWorkbook.Path
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set folderlist = FSO.GetFolder(chemin)
    Set folder = folderlist.SubFolders
    For Each Rep In folder
        browsefolder Rep
        Set ListF = Rep.Files
        For Each fich In ListF
            nr = nr + 1
            cws.Cells(nr, 1) = fich
            cws.Cells(nr, 2) = FSO.GetFile(fich).DateCreated
            If InStr(UCase(fich), ".XLS") Then
                Set nwb = Workbooks.Open(fich)
                cws.Cells(nr, 3) = nwb.Worksheets(1).Range("C30")
                nwb.Close
            End If
        Next
    Next
End Sub

Merci pour vos réponses.

Oui le 1er lien je suis déjà tombé dessus, je me suis aidé de ça mais j'ai tellement trifouiller que ça ne marchais plus.

h2so4, j'ai essayé le code, mais j'ai une erreur 13 (incompatibilité de type), If chemin = "" Then est surligné en jaune.

J'ai normalement juste à remplacer f:\ par l'adresse de mon dossier ou bien j'oublie un truc ?

Bonjour,

remplacer f:\ par le répertoire adéquat et lancer la procédure test.

Dim nr

Sub test()
    nr = 0
    browsefolder ("f:\")
End Sub
Sub browsefolder(Optional chemin="")
    Set cws = ThisWorkbook.ActiveSheet
    If chemin = "" Then chemin = ThisWorkbook.Path
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set folderlist = FSO.GetFolder(chemin)
    Set folder = folderlist.SubFolders
    For Each Rep In folder
        browsefolder Rep
        Set ListF = Rep.Files
        For Each fich In ListF
            nr = nr + 1
            cws.Cells(nr, 1) = fich
            cws.Cells(nr, 2) = FSO.GetFile(fich).DateCreated
            If InStr(UCase(fich), ".XLS") Then
                Set nwb = Workbooks.Open(fich)
                cws.Cells(nr, 3) = nwb.Worksheets(1).Range("C30")
                nwb.Close
            End If
        Next
    Next
End Sub

Salut,

OK j'ai réussi à le faire fonctionner.

En fait cela ne me donne rien du tout si le fichier de récup se trouve dans le même dossier que les fichiers à traiter, il faut que mon fichier soit dans le dossier précédent, bizarre.

En tout cas merci c'est cool

Bonsoir,

voici une correction

Dim nr

Sub test()
    nr = 0
    browsefolder ("f:\")
End Sub
Sub browsefolder(Optional chemin = "")
    Set cws = ThisWorkbook.ActiveSheet
    If chemin = "" Then chemin = ThisWorkbook.Path
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set folder = FSO.GetFolder(chemin)
    For Each fich In folder.Files
        nr = nr + 1
        cws.Cells(nr, 1) = fich
        cws.Cells(nr, 2) = FSO.GetFile(fich).DateCreated
        If InStr(UCase(fich), ".xls") Then
            Set nwb = Workbooks.Open(fich)
            cws.Cells(nr, 3) = nwb.Worksheets(1).Range("C30")
            nwb.Close
        End If
    Next
    For Each Rep In folder.SubFolders
        browsefolder Rep
    Next
End Sub

OK ca marche.

Par contre désolé je vais encore t'embêter un peu mais apparemment ca me prends aussi les autres fichiers du genre .pdf, etc.

On peut forcer uniquement sur les fichiers .xls ? je suppose que c'est l'instruction If InStr(UCase(Fich), ".xls") Then mais j'ai beau essayer de la changer de place rien n'y fait.

Et puis, petit changement, je me rend compte qu'en fait il arrive que la valeur ne soit pas toujours en C30

Par contre elle se situe toujours 2 colonnes après une cellule qui contient le mot "maxi" (par exemple si "maxi" en C29, la valeur est en E29), tu crois qu'il y a moyen de récupérer ça ?

Thanks !

Bonsoir

ceci devrait être ok. je t'ai envoyé une mauvaise version apparemment.

Dim nr

Sub test()
    nr = 0
    browsefolder ("f:\")
End Sub
Sub browsefolder(Optional chemin = "")
    Set cws = ThisWorkbook.ActiveSheet
    If chemin = "" Then chemin = ThisWorkbook.Path
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set folder = FSO.GetFolder(chemin)
    For Each fich In folder.Files
          If InStr(UCase(fich), ".XLS") Then       
          nr = nr + 1
        cws.Cells(nr, 1) = fich
        cws.Cells(nr, 2) = FSO.GetFile(fich).DateCreated

            Set nwb = Workbooks.Open(fich)
            Set re = nwb.Worksheets(1).Cells.Find("maxi", lookat:=xlWhole)
            If Not re Is Nothing Then cws.Cells(nr, 3) = re.Offset(0, 2)
            nwb.Close
        End If
    Next
    For Each Rep In folder.SubFolders
        browsefolder Rep
    Next
End Sub

C'est magnifique

Un peu long quand il y a une centaine de fichiers mais c'est toujours mieux que de s'amuser à tous les ouvrir !

En tout cas un grand merci toi h2so4 !