VBA - recherche avec sous dossier et ouverture fichier

Bonjour la communauté,

voilà, je sais que la fonction application.filesearch n'existe plus et j'en suis bien embêté.

J'ai un récapitulatif de toutes mes consultations avec des personnes, et je génère un compte rendu WORD automatique en fonction des NOM, PRENOM et d'un NUMERO.

Selon que le compte rendu est rédigé ou nom, je le place dans des dossiers différents.

Je souhaite pouvoir rechercher n'importe quel compte rendu automatiquement en fonctino du nom corespondant à la cellule active (propriété .row) et l'ouvrir, tout cela en appuyant sur un bouton, c'est à dire à partir de la variable NOM&PRENOM en le cherchant dans un dossier et ses quelques sous dossier.

Quelqu'un a t'il une piste:?:

J'ai beau chercher depuis plusieurs semaines dans les méthodes de remplacement de application.filesearch (notamment une méthode consistant à utiliser une input box et donc à rechercher manuellement) mais je ne trouve aucune solution.

Quelqu'un peut il m'orienter sur une méthode qui permette recherche et recherche sous dossier?

Avec mes remerciements.

Bonjour,

Une piste à adapter :

Sub test()

    Dim Dossier As String
    Dim Classeur As String
    Dim Chemin As String

    Dossier = "E:\Dossiers Modules\" 'adapte le chemin
    Classeur = "Mon classeur.xls" 'adapter le nom du classeur avec tes variables NOM&PRENOM

    Chemin = RecupFichier(Dossier, Classeur)

    If Chemin = "" Then

        MsgBox "Le fichier '" & Classeur & "' ne se trouve pas dans l'emplacement indiqué !"

    Else

        MsgBox "Le fichier ci-dessous :" _
               & vbCrLf _
               & Classeur _
               & vbCrLf _
               & vbCrLf _
               & "se trouve dans le dossier ci-dessous :" _
               & vbCrLf _
               & Replace(Chemin, Classeur, "")

    End If

End Sub

Function RecupFichier(Dossier As String, Classeur As String)

    Dim FSO As Object
    Dim Dos As Object
    Dim Fichier As Object
    Dim NomClasseur As String

    Set FSO = CreateObject("Scripting.FileSystemObject")

    'si le dossier n'existe pas, fin !
    If FSO.FolderExists(Dossier) = False Then

        MsgBox "Le dossier portant ce nom n'existe pas !"
        Exit Function

    End If

    'recherche dans les fichiers du dossier
    For Each Fichier In FSO.GetFolder(Dossier).Files

        If Dir(Fichier) = Classeur Then RecupFichier = Fichier: Exit Function

    Next Fichier

    'parcours les sous-dossiers
    For Each Dos In FSO.GetFolder(Dossier).SubFolders

        'recherche dans les fichiers du sous-dossier
        For Each Fichier In Dos.Files

        If Dir(Fichier) = Classeur Then RecupFichier = Fichier: Exit Function

        Next Fichier

        'rappel de la proc (récursivité)
        RecupFichier Dossier & "\" & Dos.Name, Classeur

    Next Dos

End Function

Bonjour Theze,

merci beaucoup. Ta solution est géniale et ce code très élégant .

J'aimerais vraiment pouvoir atteindre ce niveau.

Puis je te poser une autre petites questions :

- Comment dans cette fonction ou cette sub, générer une msgBox si plusieurs occurrences du fichier ont été trouvé (par exemple un fichier "Lulu.xls" dans un dossier et "lulu.xls" dans son sous-dossier)? Pour information j'ai déjà constaté que ton msgbox "Fichier introuvable dans ce dossier" apparaît justement à cette occasion cependant j'aimerais pourvoir à cette éventualité et ainsi proposer à l'utilisateur une sélection manuelle (ça je sais faire) .

Merci beaucoup de cette première aide en tout cas.

Bonjour,

Ici, j'ai transformé la fonction pour qu'elle retourne un tableau de valeurs (les chemins avec le nom du fichier), adaptes à tes besoins j'ai mis des commentaires :

Sub Test()

    Dim Tbl() As String
    Dim Dossier As String
    Dim Classeur As String
    Dim Chaine As String
    Dim I As Integer

    Dossier = "C:\Mon dossier\Mon sous-dossier\" 'adapte le chemin
    Classeur = "Mon Classeur.xls" 'adapter le nom du classeur avec tes variables NOM&PRENOM

    Tbl() = RecupFichier(Dossier, Classeur)

    If Not (Not Tbl()) Then

        'ici, les chemins et nom du fichier sont concaténés et la fonction  Replace() ci-dessous
        'supprime dans cette chaîne les noms du classeur afin de n'indiquer que les chemins
        'c'est dans cette boucle ci-dessous qu'il te faut récupérer les valeurs qui t'intéressent...
        For I = 1 To UBound(Tbl): Chaine = Chaine & Tbl(I) & vbCrLf: Next I

        MsgBox "Le fichier ci-dessous :" _
               & vbCrLf _
               & Classeur _
               & vbCrLf _
               & vbCrLf _
               & "se trouve dans le(s) dossier(s) ci-dessous :" _
               & vbCrLf _
               & Replace(Chaine, Classeur, "")

    Else

        MsgBox "Le fichier '" & Classeur & "' ne se trouve pas dans l'emplacement indiqué !"

    End If

End Sub

'fonction retournant un tableau de String (chemin et nom du fichier)
Function RecupFichier(Dossier As String, Classeur As String) As String()

    Dim FSO As Object
    Dim Dos As Object
    Dim Fichier As Object
    Dim Tbl() As String
    Dim I As Integer

    Set FSO = CreateObject("Scripting.FileSystemObject")

    'si le dossier n'existe pas, fin !
    If FSO.FolderExists(Dossier) = False Then

        MsgBox "Le dossier portant ce nom n'existe pas !"
        Exit Function

    End If

    'recherche dans les fichiers du dossier
    For Each Fichier In FSO.GetFolder(Dossier).Files

        If Dir(Fichier) = Classeur Then

            I = I + 1: ReDim Preserve Tbl(1 To I)
            Tbl(I) = Fichier

        End If

    Next Fichier

    'parcours les sous-dossiers
    For Each Dos In FSO.GetFolder(Dossier).SubFolders

        'recherche dans les fichiers du sous-dossier
        For Each Fichier In Dos.Files

        If Dir(Fichier) = Classeur Then

            I = I + 1: ReDim Preserve Tbl(1 To I)
            Tbl(I) = Fichier

        End If

        Next Fichier

        'rappel de la proc (récursivité)
        RecupFichier Dossier & "\" & Dos.Name, Classeur

    Next Dos

    'retourne un tableau contenant le chemin complet et le nom du fichier
    RecupFichier = Tbl()

End Function

Merci beaucoup.

Bon je vais devoir passer un niveau, mais c'est un bon défis.

Merci de ton aide.

Thézé,

ça y est j'ai étudié ton code, c'est parfaitement adapté à mon besoin, je t'en remercie.

J'ai vraiment besoin de pratiquer encore, je constate mes difficultés.

Peux tu m'expliquer pourquoi tu fais appelle récursivement à la fonction...

  RecupFichier Dossier & "\" & Dos.Name, Classeur 

Et quelle condition réussit à faire que cette boucle de récursivité ne tourne pas infiniment sur elle-même?

Merci en tout cas pour la qualité (à première vue à mon niveau en tout cas) de ton code.

J'aurais certainement abandonné tout seul.

Merci.

Bonjour,

Peux tu m'expliquer pourquoi tu fais appelle récursivement à la fonction...

C'est propre au compilateur, en entrant dans un dossier je pense qu'il crée un tableau et y stocke les adresses afin de pouvoir remonter au dossier et partir latéralement puis ayant fait tous les dossiers du dossier supérieur, il remonte pour faire de même dans le dossier de même niveau et ainsi de suite.

C'est ce que j'ai remarqué en créant une fonction récursive qui n'a rien à voir avec des dossiers mais avec des combinaisons de lettres dans un tableaux de tableaux

D'acc.