Recherche fichier dans dossier et sous dossier

Bonjour,

J'essaye de trouver un code qu'il me permette de trouver un fichier intitulé (Test.xls) dans un dossier avec ses sous dossiers.

Le code ci-après recherche le fichier "Test.xls" uniquement dans le dossier intitulé "A - Audits". Mais ce dossier "A - Audits" contient d'autres sous-dossiers, et j'aimerai que la recherche se fasse dans ces sous-dossiers sans modifier le chemin mentionné dans la macro à savoir : chemin = "G:\S - ISO\A - Audits\".

Est-ce possible ?

Private Sub CommandButton1_Click()
Dim Wb As Workbook
Feuil1.Select  'Feuil1(nom de gauche en projet)
chemin = "G:\S - ISO\A - Audits\"
fichier = TextBox1.Text & ".xls"
On Error Resume Next
Set Wb = GetObject(chemin & fichier)
If Err <> 0 Then MsgBox "Fichier Absent": Exit Sub

Bonjour thomasdu40,

Etant donné que tu es sur excel 2002, utilise le complément FileSearch comme ceci :

Private Sub CommandButton1_Click()
Dim nomFichier As String, i As Long, cpt As Long
nomFichier = TextBox1.Text    'nom du fichier à chercher
    With Application.FileSearch
        .NewSearch
        .LookIn = "G:\S - ISO\A - Audits\"    'on regarde dans ce répertoire
        .SearchSubFolders = True    'on regarde dans les sous-dossiers également
        .Filename = nomFichier    'nom du fichier à chercher
        .MatchTextExactly = True    'on cherche dans les fichiers qui contiennent le nom du fichier cherché
        .FileType = msoFileTypeExcelWorkbooks    'on cherche que les classeur excel
        If .Execute() > 0 Then    'si un fichier est trouvé
            For i = 1 To .FoundFiles.Count    'on boucle sur tous les fichiers comportant le nom du fichier
                If .FoundFiles(i) Like "*" & nomFichier & ".xls" Then    'si le fichier correspond exactement au nom recherché
                    cpt = cpt + 1    'on incrémente un compteur
                End If
            Next i
        End If
        If cpt > 0 Then
            MsgBox "Il y a " & cpt & " " & IIf(cpt = 1, "fichier intitulé ", "fichiers intitulés ") & """" & nomFichier & """.", vbInformation
        Else
            MsgBox "Fichier Absent", vbExclamation
        End If
    End With
End Sub

Merci vba-new

ok j'ai intégré le code mais malheureusement si il trouve le fichier il ne m'extrait pas les données voici le code original complet. Celui-ci fonctionne hormis la recherche dans les sous-dossiers. Comment puis-je intégrer ton code correctement ?

Private Sub CommandButton1_Click()
Dim Wb As Workbook
Feuil1.Select  'Feuil1(nom de gauche en projet)
Chemin = "G:\S - ISO\A - Audits\"
Fichier = TextBox1.Text & ".xls"
On Error Resume Next
Set Wb = GetObject(Chemin & Fichier)
If Err <> 0 Then MsgBox "Fichier Absent": Exit Sub
With Wb.Sheets("ConstatsISO")
For k = 8 To .[A65536].End(3).Row
If .Range("A" & k) <> "" Then
lig = [I65536].End(3).Row + 1
Range("N" & lig).Value = Wb.Sheets("Plan d'audit").[H8].Value
Range("I" & lig).Value = .Range("A" & k).Value
Range("P" & lig).Value = .Range("B" & k).Value
Range("H" & lig).Value = .Range("C" & k).Value
Range("Q" & lig).Value = .Range("D" & k).Value
Range("R" & lig).Value = .Range("E" & k).Value
End If
Next
End With

With Wb.Sheets("ConstatsISO22000")
For k = 8 To .[A65536].End(3).Row
If .Range("A" & k) <> "" Then
lig = [I65536].End(3).Row + 1
Range("N" & lig).Value = Wb.Sheets("Plan d'audit").[H8].Value
Range("I" & lig).Value = .Range("A" & k).Value
Range("P" & lig).Value = .Range("B" & k).Value
Range("H" & lig).Value = .Range("C" & k).Value
Range("Q" & lig).Value = .Range("D" & k).Value
Range("R" & lig).Value = .Range("E" & k).Value
End If
Next
End With

With Wb.Sheets("ConstatsIFS")
For k = 6 To .[C65536].End(3).Row
If .Range("C" & k) <> "" Then
lig = [I65536].End(3).Row + 1
Range("N" & lig).Value = Wb.Sheets("Plan d'audit").[H8].Value
Range("I" & lig).Value = .Range("C" & k).Value
Range("P" & lig).Value = .Range("D" & k).Value
Range("H" & lig).Value = .Range("E" & k).Value
Range("Q" & lig).Value = .Range("B" & k).Value
Range("R" & lig).Value = .Range("F" & k).Value
End If
Next
End With

With Wb.Sheets("ConstatsBRC")
For k = 6 To .[C65536].End(3).Row
If .Range("C" & k) <> "" Then
lig = [I65536].End(3).Row + 1
Range("N" & lig).Value = Wb.Sheets("Plan d'audit").[H8].Value
Range("I" & lig).Value = .Range("C" & k).Value
Range("P" & lig).Value = .Range("D" & k).Value
Range("H" & lig).Value = .Range("E" & k).Value
Range("Q" & lig).Value = .Range("B" & k).Value
Range("R" & lig).Value = .Range("F" & k).Value
End If
Next
End With

With Wb.Sheets("ConstatsIFS_BRC")
For k = 6 To .[C65536].End(3).Row
If .Range("C" & k) <> "" Then
lig = [I65536].End(3).Row + 1
Range("N" & lig).Value = Wb.Sheets("Plan d'audit").[H8].Value
Range("I" & lig).Value = .Range("C" & k).Value
Range("P" & lig).Value = .Range("D" & k).Value
Range("H" & lig).Value = .Range("E" & k).Value
Range("Q" & lig).Value = .Range("B" & k).Value
Range("R" & lig).Value = .Range("F" & k).Value
End If
Next
End With
Wb.Close
End Sub

Re,

C'est vrai qu'avec le code complet c'est mieux !

Voici le code adapté :

Private Sub CommandButton1_Click()
Dim Wb As Workbook
Dim nomFichier As String, fichierAOuvrir As String
Dim i As Long, cpt As Long, k As Long, lig As Long

Feuil1.Select  'Feuil1(nom de gauche en projet)
    nomFichier = TextBox1.Text
    With Application.FileSearch
        .NewSearch
        .LookIn = "G:\S - ISO\A - Audits\"    'on regarde dans ce répertoire
        .SearchSubFolders = True    'on regarde dans les sous-dossiers également
        .Filename = nomFichier    'nom du fichier à chercher
        .MatchTextExactly = False    'on cherche dans les fichiers qui contiennent le nom du fichier cherché
        .FileType = msoFileTypeExcelWorkbooks    'on cherche que les classeur excel
        If .Execute() > 0 Then    'si un fichier est trouvé
            For i = 1 To .FoundFiles.Count    'on boucle sur tous les fichiers comportant le nom du fichier
                If .FoundFiles(i) Like "*" & nomFichier & ".xls" Then    'si le fichier correspond exactement au nom recherché
                    fichierAOuvrir = .FoundFiles(i)
                    cpt = cpt + 1    'on incrémente un compteur
                End If
            Next i
        End If
        If cpt > 0 Then
            MsgBox "Il y a " & cpt & " " & IIf(cpt = 1, "fichier intitulé ", "fichiers intitulés ") & """" & nomFichier & """.", vbInformation
        Else
            MsgBox "Fichier Absent", vbExclamation: Exit Sub
        End If
    End With
    Workbooks.Open (fichierAOuvrir)
    Set Wb = ActiveWorkbook
    With Wb.Sheets("ConstatsISO")
        For k = 8 To .[A65536].End(3).Row
            If .Range("A" & k) <> "" Then
                lig = [I65536].End(3).Row + 1
                Range("N" & lig).Value = Wb.Sheets("Plan d'audit").[H8].Value
                Range("I" & lig).Value = .Range("A" & k).Value
                Range("P" & lig).Value = .Range("B" & k).Value
                Range("H" & lig).Value = .Range("C" & k).Value
                Range("Q" & lig).Value = .Range("D" & k).Value
                Range("R" & lig).Value = .Range("E" & k).Value
            End If
        Next
    End With

    With Wb.Sheets("ConstatsISO22000")
        For k = 8 To .[A65536].End(3).Row
            If .Range("A" & k) <> "" Then
                lig = [I65536].End(3).Row + 1
                Range("N" & lig).Value = Wb.Sheets("Plan d'audit").[H8].Value
                Range("I" & lig).Value = .Range("A" & k).Value
                Range("P" & lig).Value = .Range("B" & k).Value
                Range("H" & lig).Value = .Range("C" & k).Value
                Range("Q" & lig).Value = .Range("D" & k).Value
                Range("R" & lig).Value = .Range("E" & k).Value
            End If
        Next
    End With

    With Wb.Sheets("ConstatsIFS")
        For k = 6 To .[C65536].End(3).Row
            If .Range("C" & k) <> "" Then
                lig = [I65536].End(3).Row + 1
                Range("N" & lig).Value = Wb.Sheets("Plan d'audit").[H8].Value
                Range("I" & lig).Value = .Range("C" & k).Value
                Range("P" & lig).Value = .Range("D" & k).Value
                Range("H" & lig).Value = .Range("E" & k).Value
                Range("Q" & lig).Value = .Range("B" & k).Value
                Range("R" & lig).Value = .Range("F" & k).Value
            End If
        Next
    End With

    With Wb.Sheets("ConstatsBRC")
        For k = 6 To .[C65536].End(3).Row
            If .Range("C" & k) <> "" Then
                lig = [I65536].End(3).Row + 1
                Range("N" & lig).Value = Wb.Sheets("Plan d'audit").[H8].Value
                Range("I" & lig).Value = .Range("C" & k).Value
                Range("P" & lig).Value = .Range("D" & k).Value
                Range("H" & lig).Value = .Range("E" & k).Value
                Range("Q" & lig).Value = .Range("B" & k).Value
                Range("R" & lig).Value = .Range("F" & k).Value
            End If
        Next
    End With

    With Wb.Sheets("ConstatsIFS_BRC")
        For k = 6 To .[C65536].End(3).Row
            If .Range("C" & k) <> "" Then
                lig = [I65536].End(3).Row + 1
                Range("N" & lig).Value = Wb.Sheets("Plan d'audit").[H8].Value
                Range("I" & lig).Value = .Range("C" & k).Value
                Range("P" & lig).Value = .Range("D" & k).Value
                Range("H" & lig).Value = .Range("E" & k).Value
                Range("Q" & lig).Value = .Range("B" & k).Value
                Range("R" & lig).Value = .Range("F" & k).Value
            End If
        Next
    End With
    Wb.Close
End Sub

Re,

Non il ne m'extrait pas les données comme il faudrait.

En gros, cette macro se trouve dans un fichier appelé "Plan d'action SMQ". En la faisant fonctionner elle va extraire les informations présentes dans le fichier recherché et issues des onglets "Constats..." pour les coller dans le "Plan d'action SMQ".

Avec ce code il me colle les données directement dans le fichier recherché.

Je ne savais pas comment marche ta macro ! Essaie comme ceci :

Private Sub CommandButton1_Click()
Dim WbPrincipal As Workbook, Wb As Workbook
Dim nomFichier As String, fichierAOuvrir As String
Dim i As Long, cpt As Long, k As Long, lig As Long

Set WbPrincipal = ActiveWorkbook
WbPrincipal.Feuil1.Select  'Feuil1(nom de gauche en projet)
   nomFichier = TextBox1.Text
    With Application.FileSearch
        .NewSearch
        .LookIn = "G:\S - ISO\A - Audits\"    'on regarde dans ce répertoire
       .SearchSubFolders = True    'on regarde dans les sous-dossiers également
       .Filename = nomFichier    'nom du fichier à chercher
       .MatchTextExactly = False    'on cherche dans les fichiers qui contiennent le nom du fichier cherché
       .FileType = msoFileTypeExcelWorkbooks    'on cherche que les classeur excel
       If .Execute() > 0 Then    'si un fichier est trouvé
           For i = 1 To .FoundFiles.Count    'on boucle sur tous les fichiers comportant le nom du fichier
               If .FoundFiles(i) Like "*" & nomFichier & ".xls" Then    'si le fichier correspond exactement au nom recherché
                   fichierAOuvrir = .FoundFiles(i)
                    cpt = cpt + 1    'on incrémente un compteur
               End If
            Next i
        End If
        If cpt > 0 Then
            MsgBox "Il y a " & cpt & " " & IIf(cpt = 1, "fichier intitulé ", "fichiers intitulés ") & """" & nomFichier & """.", vbInformation
        Else
            MsgBox "Fichier Absent", vbExclamation: Exit Sub
        End If
    End With
    Workbooks.Open (fichierAOuvrir)
    Set Wb = ActiveWorkbook
    Windows(WbPrincipal.Name).Activate
    WbPrincipal.Feuil1.Select  'Feuil1(nom de gauche en projet)
    With Wb.Sheets("ConstatsISO")
        For k = 8 To .[A65536].End(3).Row
            If .Range("A" & k) <> "" Then
                lig = [I65536].End(3).Row + 1
                Range("N" & lig).Value = Wb.Sheets("Plan d'audit").[H8].Value
                Range("I" & lig).Value = .Range("A" & k).Value
                Range("P" & lig).Value = .Range("B" & k).Value
                Range("H" & lig).Value = .Range("C" & k).Value
                Range("Q" & lig).Value = .Range("D" & k).Value
                Range("R" & lig).Value = .Range("E" & k).Value
            End If
        Next
    End With

    With Wb.Sheets("ConstatsISO22000")
        For k = 8 To .[A65536].End(3).Row
            If .Range("A" & k) <> "" Then
                lig = [I65536].End(3).Row + 1
                Range("N" & lig).Value = Wb.Sheets("Plan d'audit").[H8].Value
                Range("I" & lig).Value = .Range("A" & k).Value
                Range("P" & lig).Value = .Range("B" & k).Value
                Range("H" & lig).Value = .Range("C" & k).Value
                Range("Q" & lig).Value = .Range("D" & k).Value
                Range("R" & lig).Value = .Range("E" & k).Value
            End If
        Next
    End With

    With Wb.Sheets("ConstatsIFS")
        For k = 6 To .[C65536].End(3).Row
            If .Range("C" & k) <> "" Then
                lig = [I65536].End(3).Row + 1
                Range("N" & lig).Value = Wb.Sheets("Plan d'audit").[H8].Value
                Range("I" & lig).Value = .Range("C" & k).Value
                Range("P" & lig).Value = .Range("D" & k).Value
                Range("H" & lig).Value = .Range("E" & k).Value
                Range("Q" & lig).Value = .Range("B" & k).Value
                Range("R" & lig).Value = .Range("F" & k).Value
            End If
        Next
    End With

    With Wb.Sheets("ConstatsBRC")
        For k = 6 To .[C65536].End(3).Row
            If .Range("C" & k) <> "" Then
                lig = [I65536].End(3).Row + 1
                Range("N" & lig).Value = Wb.Sheets("Plan d'audit").[H8].Value
                Range("I" & lig).Value = .Range("C" & k).Value
                Range("P" & lig).Value = .Range("D" & k).Value
                Range("H" & lig).Value = .Range("E" & k).Value
                Range("Q" & lig).Value = .Range("B" & k).Value
                Range("R" & lig).Value = .Range("F" & k).Value
            End If
        Next
    End With

    With Wb.Sheets("ConstatsIFS_BRC")
        For k = 6 To .[C65536].End(3).Row
            If .Range("C" & k) <> "" Then
                lig = [I65536].End(3).Row + 1
                Range("N" & lig).Value = Wb.Sheets("Plan d'audit").[H8].Value
                Range("I" & lig).Value = .Range("C" & k).Value
                Range("P" & lig).Value = .Range("D" & k).Value
                Range("H" & lig).Value = .Range("E" & k).Value
                Range("Q" & lig).Value = .Range("B" & k).Value
                Range("R" & lig).Value = .Range("F" & k).Value
            End If
        Next
    End With
    Wb.Close False
End Sub

Merci à toi cette fois-ci tout fonctionne parfaitement.

Bonjour ce que je voudrais faire, c est un peu le meme principe.

Premièrement je suis sous Excel 2013.

J'ai un tableau avec des noms de pieces (du type PC96582) dans la colonne de gauche. Pour chaque pièces j'ai besoin d'aller chercher un dossier dans le fin fond de mon disque dur, de l'ouvrir et de copier les valeurs de la feuille " METHODES " de la cellule C4 à AV4, pour après les coller de la cellule Gi à ACi (j'ai mis "i" pour vous faire comprendre que à chaque fois que l'on change de pièce on descend d'un ligne.

Il faut savoir que le nom du fichier que je recherche commence toujours par " OP45_Tournage_ " et ce fini par le nom de la pièce.

Je cherche chaque fichier dans l'emplacement "E:\06-Dossier"

Je suis débutant dans le milieu, du coup je dispas non à un petit coup de pouce

364piece-a-chercher.xlsm (19.19 Ko)

Bonjour

Je n'ai jamais fait de maccro. Ce jour Jessai de trouver une solution pour aller rechercher un code dans le nom d'un fichier et qu'il m'en mette le lien. J'ai plus de 300 fichier à chercher et ceux chaque année du coup je me dis que via Excel y a peut être moyen de faire quelque chose sans perdre trop de temps à la main. Mais partant de 0 je cherche sur les forums je vois des choses intéressantes mais je n'arrive pas à les mettre en place.

Du coup j'en fait appel à votre aide.

Explications.

J'ai un tableau avec en colonne à des code article à 7 chiffres en B les libellé en C D E F G diverses info du produits. Et donc j'aimerais qu'en IJKLM... Il vienne me mettre le lien de la fiche.

Les fiches suivent un process de créa elles d'abord en créa ensuite en Ft.... Les colonnes IJKLM représentent donc ou en est la fiche.

Donc il me faudrait un code simple pour chercher le lien de la fiche dans un dossier et sous dossier sachant que le nom de la fiche contient le code article c'est Dailleur le début du nom de la fiches.

Je pense que si le premier code et fait je pourrais essayer de le copier pour le refaire sur les autres dossier.

En espérant avoir été claire, et que vous pourrez m'aider.

Merci d'avance.

Prenez soin de vous

Rechercher des sujets similaires à "recherche fichier dossier"