VBA, recherche dans plusieurs repertoire

Bonjour à tous,

J'ai lu et cherché sur plusieurs forum et je ne trouve pas ma solution, donc je me tourne vers vous pour voir si vous pouvez m'aider.

J'essaye de faire une macro qui dois chercher à partir d'un repertoire à définir (ça c'est bon j'y arrive), certain fichier excel. Je m'explique, je ne veux pas que la macro me sorte tous les fichiers excel qui se trouve dans le repertoire et ses sous-repertoires. Mais que ceux avec une certaine caractéristique qui se trouve sur le nom du fichier: *PTC*.xls (si ça peut vous aider)

D'avance merci pour ceux qui pourront m'aider ou ceux qui auront pris le temps de lire ceci mais sans pouvoir m'aider

Bonjour et bienvenue sur ce forum.

Place ce code dans ta macro :

With Application.FileSearch
    .LookIn = "le chemin de ton répertoire"
    .Filename = "*PTC*"
End With

Amicalement

Dan

Merci pour ta rapide réponse Dan. Le souci, c'est que tes lignes de VBA fonctionne mais je dois relancer la macro pour chaque répertoire.

Je voudrais mettre cette macro à la racine et quand je la lance, elle fais le boulot toute seule comme une grande et me synthétise le tout dans le fichier de recherche, et la sa bug.

    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show
        fLdr = .SelectedItems(1)
    End With
     '**********************************************************************
    With Application.FileSearch
    .NewSearch
    .LookIn = fLdr
    .SearchSubFolders = True
    .Filename = "*PTC*.*"

re,

Et si tu définissais une variable pour chacun de tes répertoires.

exemple :

Dim chemin1 as string, chemin2 as string
chemin1 = C:......
chemin2 = D:.....
With Application.FileSearch 
    .LookIn = chemin1
    .Filename = "*PTC*" 
End With
.....
With Application.FileSearch 
    .LookIn = chemin2
......

Amicalement

Dan

voici 2 codes dont un développé par un ami Excelien du forum et le second par moi même:

Sub Listerdossiers2()

'déclaration de variables
Dim arret As Boolean

'Permet de fournir la liste des sous dossier dans un dossier

a = [B4] & " mon répertoire" 'avec B4 = la lettre réseau

' si B4 est vide alors erreur...
If [B4] = "" Then
MsgBox ("entrez votre lettre réseau...")
Exit Sub
End If

'... sinon:
    Dim fs, f, f1, s, sf
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(a)
    Set sf = f.SubFolders

'Coller les noms de dossiers présents
    For Each f1 In sf
        s = f1.Name
        Sheets("feuil2").Select

        'Ecriture en dessous de la ligne 14
        Cells(15 + i, 3).Select
        ActiveCell.FormulaR1C1 = s

   i = i + 1
   Next
Exit Sub

End Sub

Ce premier code te permet de lister les noms de dossiers sur une page Excel

et le second code:

Sub CONF2()

'*****************************
'INTRODUCTION MACRO
'*****************************
'déclaration variables
Dim arret As Boolean
Dim DerniereCelluleRemplie
Dim i As Integer
Dim dossiers As Range
Dim repertoire As String

'nettoyer la page"XX"
Sheets("XX").Select
Range("A3").Select
Selection.CurrentRegion.Select
Cells.Clear

'selection de la lettre réseau
Sheets("feuil1").Select
Range("B4").Select

'si la cellule active = "", erreur
If ActiveCell = "" Then
MsgBox ("entrez votre lettre réseau...")

arret = True
Else

'sinon si B4 =* alors:
Sheets("feuil1").Select
Range("C15").Select

' EN CAS D'ERREUR, FAIRE ABSTRACTION
On Error Resume Next

'*****************************
'MACRO
'*****************************
repertoire = Worksheets("feuil1").Range("C13").Value 'en C13, j'ai inserer un concatener de ma lettre réseau et de mon répertoire

'selection de la liste de dossiers
Worksheets("feuil1").Activate
Range("C15").Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select

'DEBUT boucle de recherche des dossiers
 For Each dossiers In Selection

  'existence du dossier dans le répertoire
  Set fs = Application.FileSearch:
 With fs
   .LookIn = repertoire & dossiers
    .Filename = "*.pdf"

'executer la macro
.Execute

'les mettre les uns en dessous des autres
Sheets("XX").Select
    DerniereCelluleRemplie = Columns("A:A").Find("*", Range("A1"), , , xlByRows, xlPrevious).Row
    Range("A" & DerniereCelluleRemplie + 1).Select
    For i = 1 To .FoundFiles.Count
Cells(i + DerniereCelluleRemplie, 1) = .FoundFiles(i)
Next
End With
Next
End If
End Sub

Si cela peut t'aider.... si tu as des problèmes avec le code, contactes moi par MP,

A+

Souri84

Édition par Mytå, ajustement de la mise en page.

Bonjour Dan et Souri84,

Merci pour vos réponses.

J'ai mis un peu de temps pour retranscrire le tout à ma sauce et j'ai essayer vos progrmmes réciproque et il n'y a que le dernier qui fonctionne à peu près.

Il me trouve bien les fichiers mais uniquement si je spécifie le repertoire qui les contients et il me les trouves plusieurs fois. Par contre, dés que je rentre le repertoire en niveau +1, il n'y a rien qui sort...

Est-ce que le problème peux venir que les fihciers que je cherche sont sur le réseau de ma boite (et non sur un disc local)?

En tout cas, je vous remercie pour le temps que vous m'avez consacrer.

Si vous avez d'autre idées, je les essayerai avec joie.

Bonne journée

Jo