Recherche fichiers en VBA

Bonjour à tous , je debut en VBA et il s'avère que je suis bloqué.

Ici le but de ce fichier est de ressortir un dossier qui contient différents fichiers (présent sur un réseau intranet).

Je souhaite afficher les fichiers présents sur des feuilles spécifiques en fonction des dossier (Exemple : Feuille « Mécanique » représente le dossier « Mécanique » et contiendra tous les fichiers présent dans ce dossier).

Sur chaque page j’ai un bouton « REFRESH » et je dois faire une seule et unique macro (que j’affecterai à chacun de ces boutons) qui me permet d’actualiser les fichiers présents dans les dossiers du disque réseau.

Et je n’arrive pas à changer le dernier nom de dossier de ma destination en fonction de ma page, admettons ma page est « MECANIQUE » alors il faudra que le code aille chercher "K:\DOCUMENTATION\Architecture\MECANIQUE"

J’ai essayé différentes choses mais rien de concluant, en espérant avoir été clair.

Merci d’avance.

Sub TestListeFichiers()
    Dim Dossier As String

    n = ActiveSheet.Name
      Chemin = "K:\DOCUMENTATION\Architecture documentaire\" & n
    'Définit le répertoire pour débuter la recherche de fichiers.
    Dossier = "K:\DOCUMENTATION\Architecture\"& n

    'Appelle la procédure de recherche des fichiers
    ListeFichiers Dossier

    'Ajuste la largeur des colonnes A:E en fonction du contenu des cellules.
    Columns("A:C").AutoFit
    MsgBox "Terminé"
End Sub

Sub ListeFichiers(Repertoire As String)

    Dim Fso As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder
    Dim SubFolder As Scripting.Folder
    Dim FileItem As Scripting.File
    Dim i As Long

    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(Repertoire)

    'Récupère le numéro de la dernière ligne vide dans la colonne A.
    i = Range("A65536").End(xlUp).Row + 1

    'Boucle sur tous les fichiers du répertoire
    For Each FileItem In SourceFolder.Files
        'Inscrit le nom du fichier dans la cellule
        Cells(i, 1) = FileItem.Name
        'Ajoute un lien hypertexte vers le fichier
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), _
            Address:=FileItem.ParentFolder & "\" & FileItem.Name
        'Indique la date de création
        Cells(i, 2) = FileItem.DateCreated
        'Nom du répertoire
        Cells(i, 5) = FileItem.ParentFolder

    Next FileItem

    '--- Appel récursif pour lister les fichier dans les sous-répertoires ---.
    For Each SubFolder In SourceFolder.subfolders
        ListeFichiers SubFolder.Path
    Next SubFolder

End Sub

Bonjour Dumas

Une petite présentation ICI serait la bienvenue

Si vous ne l'avez pas encore fait, je vous invite à lire la charte du forum [A LIRE AVANT DE POSTER] qui vous aidera dans vos demandes et réponses sur ce forum

=> Pour ce qui concerne votre demande, la première chose à faire est de mettre "Option Explicit" en entête de module
Cela va vous obliger à définir vos variables et vous pourriez comprendre alors votre/vos erreur(s)

Sinon, à essayer

Dossier = "K:\DOCUMENTATION\Architecture\"& n & "\"

Merci de votre participation

Cordialement

Je vais faire ça, je n'avais pas eu le temps.

Merci ! Ca fonctionne mais il y a un dossier qui se nomme "Création d'un document" et les fichiers ne s'affiche pas.

Je pense que l'apostrophe pose un problème.

Re,

Avez-vous des dossiers et sous-dossier pour vos fichiers

Sinon la Sub ListeFichiers n'est pas utile, on peut faire plus simple

A+

Merci de votre réponse , oui j'ai des sous dossiers avec des fichiers dedans.

Je n'arrive pas à faire fonctionner ma macro sans la Sub ListFichiers... Je vais essayer de voir ce que je peux faire de plus !

Re,

Essayez avec ce code, pour être certain de la fin des dossier

Sub TestListeFichiers()
    Dim Chemin As String
    Dim Dossier As String
    Dim SousDos As String
    ' Chemin initial
    Chemin = "K:\DOCUMENTATION\Architecture\"
    If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"
    ' Sous-dossier selon le nom de l'onglet
    SousDos = ActiveSheet.Name
    If Right(SousDos, 1) <> "\" Then SousDos = SousDos & "\"
    ' Dossier à scanner
    Dossier = Chemin & SousDos
    'Appelle la procédure de recherche des fichiers
    ListeFichiers Dossier

    'Ajuste la largeur des colonnes A:E en fonction du contenu des cellules.
    Columns("A:C").AutoFit
    MsgBox "Terminé"
End Sub

Sub ListeFichiers(Repertoire As String)
    Dim Fso As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder
    Dim SubFolder As Scripting.Folder
    Dim FileItem As Scripting.File
    Dim i As Long

    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(Repertoire)

    'Récupère le numéro de la dernière ligne vide dans la colonne A.
    i = Range("A65536").End(xlUp).Row + 1

    'Boucle sur tous les fichiers du répertoire
    For Each FileItem In SourceFolder.Files
        'Inscrit le nom du fichier dans la cellule
        Cells(i, 1) = FileItem.Name
        'Ajoute un lien hypertexte vers le fichier
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), _
            Address:=FileItem.ParentFolder & "\" & FileItem.Name
        'Indique la date de création
        Cells(i, 2) = FileItem.DateCreated
        'Nom du répertoire
        Cells(i, 5) = FileItem.ParentFolder

    Next FileItem

    '--- Appel récursif pour lister les fichier dans les sous-répertoires ---.
    For Each SubFolder In SourceFolder.subfolders
        ListeFichiers SubFolder.Path
    Next SubFolder

End Sub

A+

Désolé de vous expliquer au compte gouttes et de vous embêter,

en fait c'est un dossier "DOCUMENTATION" composé de plusieurs dossiers, ici c'est :"Architecture documentaire" qui contient les fichiers qui m'intéressent dont le dossier "MECANIQUE" et le sous dossiers "TOTO".

K:\DOCUMENTATION\

K:\DOCUMENTATION \Architecture documentaire \

K:\DOCUMENTATION \Architecture documentaire \Mécanique\

K:\DOCUMENTATION \Architecture documentaire\Mécanique\TOTO

(Pas tous les dossiers ont des sous dossiers mais ça peut arriver)

Merci

Re,

Je m'en doutais, donc la "Sub ListeFichiers(Repertoire As String)" est obligatoire.

J'ai modifié ma réponse précédente et vous est mis le code qui fonctionne parfaitement chez moi
même avec un sous-dossier nommé "Création d'un document"

A+

Merci beaucoup :)

Passez une excellente soirée !

Je n'avais pas du tout penser à ça :

 If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"
    ' Sous-dossier selon le nom de l'onglet
    SousDos = ActiveSheet.Name
    If Right(SousDos, 1) <> "\" Then SousDos = SousDos & "\"
    ' Dossier à scanner
    Chemin = Chemin & SousDos

Merci excellente soirée à vous également

Je n'avais pas du tout penser à ça

nous sommes aussi là pour ça