Récupérer noms de fichiers d'un répertoire selon les valeur dans une colonne->Résolu

[lostsysmo]

Bonjour,
J'ai utilisé une macro de récupération des fichiers avec lien hypertexte (voir code plus bas)

Sauf que j'ai un besoin particulier:

J'ai un répertoire dans lequel il y a plusieurs fichiers, chaque fichier est nommé d'une façon standard:

"Nom salle_type de données" (il y a 3 types de données)

mon fichier Excel est composé de 4 colonnes :
A=nom salle; B=Chemin fichier type de données1; C=Chemin fichier type de données2; D=Chemin fichier type de données3

Le but, est de pouvoir ouvrir un répertoire:
Récupérer les noms des salles (sans doublon) dans la colonne A
Récupérer le chemin du fichier type de données 1 dans la colonne B (s'il y en a) selon la valeur de la colonne A(Hypertexte)
Récupérer le chemin du fichier type de données 2 dans la colonne C (s'il y en a)selon la valeur de la colonne A(Hypertexte)
Récupérer le chemin du fichier type de données 3 dans la colonne D(s'il y en a)selon la valeur de la colonne A(Hypertexte)

Voici le code que j'ai un peu bricolé pour récupérer les valeurs sans doublons dans la colonne A.

 Sub LireFichier()
    Dim Obj, RepP, Fich, TB, F
    Dim Rep As String, i As Integer, x As Integer
    
        Range("a2:g200").ClearContents 'suuprimer les cellule remplies_____________
        
        
        With Application.FileDialog(msoFileDialogFolderPicker)
            .Show
            On Error Resume Next 'si annuler
           Rep = .SelectedItems(1)
            If Err.Number <> 0 Then Exit Sub
        End With
        Rep = Rep & "\"
        Set Obj = CreateObject("Scripting.FileSystemObject")
        Set RepP = Obj.Getfolder(Rep)
        Set Fich = RepP.Files
        With ActiveSheet
            i = 2 'première ligne où commencer
           On Error Resume Next 'si pas d'extension
           For Each F In Fich
           
            
            
           TB = Split(F.Name, "_Liste")
                .Cells(i, "f") = TB(0)
               
        'Et éventuellement un lien HyperText pour appeler le fichier
               .Hyperlinks.Add Anchor:=.Cells(i, "g"), Address:= _
                   Rep & F.Name, TextToDisplay:=Rep & F.Name
                   
                                    
                i = i + 1
            Next F
            
            
        'Placer les valeurs sans doublon dans la colonne a
                Range("f2:f200").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("a2"), Unique:=True
        
                      
         End With
        Set Obj = Nothing
        Set RepP = Nothing
        Set Fich = Nothing
       End Sub

Merci

 

[lostsysmo]

Re : Récupérer noms de fichiers d'un répertoire selon les valeur dans une colonne

Bonjour,

Pour avoir le résultat escompté j'ai encore bricolé le même code, ça donne ceci
A mon sens, de novice de chez les novices, il y a une logique mais ça ne marche pas!

Je vous livre le fichier zip contenant la macro et un exemple de fichiers,
Pour résumer un peu mes message, le résultat escompté (selon l'exemple fourni) se trouve dans le fichier zip

J'espère vraiment que quelqu'un me vienne en aide, j'en ai vraiment besoin.


Bonne journée à tous.

 

[lostsysmo]

Re : Récupérer noms de fichiers d'un répertoire selon les valeur dans une colonne

c'est résolu!! Voir le lien ci-dessous:
Récupérer nom des fichiers présent dans un dossier ? : Excel - VBA

Bonne journée