Lister des fichiers d'un repertoire dont le nom contient certains caracteres

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion PAT0051
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
P

PAT0051

XLDnaute Nouveau
Bonjour à tous,

Je souhaite lister le nom des fichiers contenu dans un répertoire.
Pour lister les nom, pas de problème pour la macro, mais je souhaiterai lister seulement les fichiers contenant certains caractères, commençant par A uniquement et terminant par XXX, par exemple (les nom a selectionner ayant tous 10 caractères ....
Ci-joint le code que j'utilise pour lister les noms de fichier

Code: 
Sub ListeFichiers(Repertoire As String)

    'Nécessite d'activer la référence "Microsoft Scripting RunTime"
    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
        i = i + 1
    Next FileItem
    
End Sub


Quelqu’un à déjà eu ce besoin.
 
Trier par date Trier par votes
Re : Lister des fichiers d'un repertoire dont le nom contient certains caracteres

Bonjour à tous


A priori ainsi amendé, ton code semble faire l'affaire
Code: 
Sub ListeFichiers(Repertoire As String)

    'Nécessite d'activer la référence "Microsoft Scripting RunTime"
    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
    If FileItem.Name Like "A*XXX.???" Then 'ajout ici
        'Inscrit le nom du fichier dans la cellule
        Cells(i, 1) = FileItem.Name
        End If
        'Ajoute un lien hypertexte vers le fichier
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), _
           Address:=FileItem.ParentFolder & "\" & FileItem.Name
        i = i + 1
    Next FileItem
   
End Sub
 
Vote positif 0 Vote négatif
Re : Lister des fichiers d'un repertoire dont le nom contient certains caracteres

Bonjour et merci de ton aide,

Je viens de tester la condition mais j'ai toujours les noms des autre fichier qui remontent mais la présentation est différente. les fichiers sur lesquels j'ai effectué le trie "TEST*.xls*" sont bien sélectionnés mais les autres fichiers du répertoire sont aussi présents.
Regarde la pièce jointe Capture-1.pdf
 
Vote positif 0 Vote négatif
Re : Lister des fichiers d'un repertoire dont le nom contient certains caracteres

Re

Donc pour être plus précis, voici une petite macro illustrative
(la fonction vient du fil de JPN que je salue au passage)
Code: 
Function Teste(ATester As String, MonPattern As String, MonType As String) As Boolean
Dim Match, Matches
With CreateObject("vbscript.regexp")
    .Global = True
    .Pattern = MonPattern
    Set Matches = .Execute(ATester)
    If MonType = "Unique" Then
    ' Choix sur la fonction pour savoir si le résultat de Matches doit être unique
    If Matches.Count = 1 Then Teste = True Else Teste = False
    Else
    ' Sinon, si on accepte plusieurs occurences
    If Matches.Count >= 1 Then Teste = True Else Teste = False
    ' Renvoie Vrai si c'est le cas
    End If
End With
End Function
Code: 
Sub aaa()
Dim NomFic$, NomFicX$
NomFic = "AtestesXXX.xlsx"
NomFicX = Split(NomFic, ".")(0)
MsgBox Teste(NomFicX, "^\A\w{6}\XXX$", "Unique"), vbInformation, NomFic
NomFic = "BtestesXXX.xlsx"
NomFicX = Split(NomFic, ".")(0)
MsgBox Teste(NomFicX, "^\A\w{6}\XXX$", "Unique"), vbCritical, NomFic
End Sub
Pour l’utiliser dans ton code, il faudrait écrire un truc du genre
Code vba:
'ici début de ton code initial
For Each FileItem In SourceFolder.Files
NomSansExt = Split(FileItem.Name, ".")(0)
If Teste(NomSansExt, "^\A\w{6}\XXX$", "Unique") Then
'Inscrit le nom du fichier dans la cellule
 MsgBox FileItem.Name ' ici pour test
'ici fin de ton code initial



Je le laisse faire en faisant les modifs.

PS: J'ai testé avec ces noms de fichiers: A123456XXX.txt et AtestesXXX.txt
(la fonction renvoie VRAI avec ces deux noms qui matchent tes critères:
un nom de fichier de 10 caractères qui comme par A et fini par XXX
 
Vote positif 0 Vote négatif
Re : Lister des fichiers d'un repertoire dont le nom contient certains caracteres

Bonjour Pat0051; Staple1600; le Forum

Une variante avec Fso.GetExtensionName.


Code: 
Sub ListeFichiers(Repertoire As String)

    'Nécessite d'activer la référence "Microsoft Scripting RunTime"
    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
     strExtension = Fso.GetExtensionName(FileItem.Name)
     If Right(strExtension, 1) = "." Then strExtension = Mid(strExtension, 1, Len(strExtension) - 1)
     
     NomSansExtension = Mid(FileItem.Name, 1, Len(FileItem.Name) - Len(strExtension))
    
    If UCase(NomSansExtension) Like "A*" And Len(NomSansExtension) = 10 Then 'ajout ici
     
        '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
        i = i + 1
        End If
    Next FileItem
    
End Sub


Cordialement

Docmarti
 
Vote positif 0 Vote négatif
Re : Lister des fichiers d'un repertoire dont le nom contient certains caracteres

Déjà, merci à tous deux de vous occuper de mon problème mais je n'ai que de notion de base en VBA et je bidouille les codes que je trouve en testant, retestant et rere....

Je viens de rentrer le code de Docmarti et cela fonctionne, je peux réaliser les tries que je souhaite 😎
Par contre pour ton code, Staple1600, je pense avoir bien copié la fonction dans le module mais je dois avoir une erreur quelque part......la fonction Teste reste non indéfinie 😕
Code: 
Sub ListeFichiers(Repertoire As String)

    'Nécessite d'activer la référence "Microsoft Scripting RunTime"
    Dim Fso As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder
    Dim SubFolder As Scripting.Folder
    Dim FileItem As Scripting.File
    Dim i As Long
    Dim NomSansExt$
    
    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
        NomSansExt = Split(FileItem.Name, ".")(0)
            If Teste(NomSansExt, "^\A\w{6}\XXX$", "Unique") Then
            'Inscrit le nom du fichier dans la cellule
            MsgBox FileItem.Name ' ici pour test
            Cells(i, 1) = FileItem.Name
            End If
        'Ajoute un lien hypertexte vers le fichier
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), _
           Address:=FileItem.ParentFolder & "\" & FileItem.Name
        i = i + 1
    Next FileItem
   
End Sub
 
Vote positif 0 Vote négatif
Re : Lister des fichiers d'un repertoire dont le nom contient certains caracteres

Re


Normalement tu devrais avoir tout cela dans ton module
(Elle n'apparaissait dans le copier/coller de ton dernier message, donc je l'ai remis, voir ci-dessous)
PAT0051 à dit:
Par contre pour ton code, Staple1600, je pense avoir bien copié la fonction dans le module mais je dois avoir une erreur quelque part......la fonction Teste reste non indéfinie 😕
Code: 
Sub ListeFichiers(Repertoire As String)

    'Nécessite d'activer la référence "Microsoft Scripting RunTime"
    Dim Fso As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder
    Dim SubFolder As Scripting.Folder
    Dim FileItem As Scripting.File
    Dim i As Long
    Dim NomSansExt$
    
    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
        NomSansExt = Split(FileItem.Name, ".")(0)
            If Teste(NomSansExt, "^\A\w{6}\XXX$", "Unique") Then
            'Inscrit le nom du fichier dans la cellule
            MsgBox FileItem.Name ' ici pour test
            Cells(i, 1) = FileItem.Name
            End If
        'Ajoute un lien hypertexte vers le fichier
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), _
           Address:=FileItem.ParentFolder & "\" & FileItem.Name
        i = i + 1
    Next FileItem
   
End Sub
'Je remets la fonction Teste
Code: 
Function Teste(ATester As String, MonPattern As String, MonType As String) As Boolean
Dim Match, Matches
With CreateObject("vbscript.regexp")
    .Global = True
    .Pattern = MonPattern
    Set Matches = .Execute(ATester)
    If MonType = "Unique" Then
    ' Choix sur la fonction pour savoir si le résultat de Matches doit être unique
    If Matches.Count = 1 Then Teste = True Else Teste = False
    Else
    ' Sinon, si on accepte plusieurs occurences
    If Matches.Count >= 1 Then Teste = True Else Teste = False
    ' Renvoie Vrai si c'est le cas
    End If
End With
End Function
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
Re : Lister des fichiers d'un repertoire dont le nom contient certains caracteres

Et de 3 solutions qui fonctionnent....cela 15 jours que je butais sur ce problème...
Le choix va être dur, je vais y réfléchir en faisant une petite pose ......et des crêpes.

Merci à tous
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

W
  • Résolu(e)
XL 2016 Placer mes photos dans la colonne A, [A3], [A4],etc, jusqu'en [A99] selon le prénom et le nom colonnes B et C
2
Réponses
26
Affichages
986
Webperegrino
W
C
  • Résolu(e)
XL 2021 Sauvegarder répertoire/sous répertoire un peu volumineux 2 Go
Réponses
7
Affichages
354
Claudinedu13
C
J
  • Question Question
Microsoft 365 macro qui ouvre des fichiers excel de type "analyze in excel" généré par power bi et met à jour un filtre "mois" sur plusieurs tcd
Réponses
0
Affichages
562
JJ69
J
patricktoulon
zip And unzip des éléments d'un fichier de type zip y compris les fichiers Excelavec la commande (TAR)
Réponses
2
Affichages
430
patricktoulon
patricktoulon
V
  • Question Question
Microsoft 365 Recherche de répertoire à partir d'une URL
Réponses
3
Affichages
913
fanch55
fanch55
H
  • Résolu(e)
Microsoft 365 Incrémentation d'un numéro de devis/facture
2
Réponses
24
Affichages
3 K
dysorthographie
dysorthographie
Usine à gaz
  • Résolu(e)
Microsoft 365 lister des fichiers
2
Réponses
19
Affichages
3 K
Usine à gaz
Usine à gaz
M
  • Question Question
XL 2010 Récurssivité non fonctionnelle
2 3
Réponses
39
Affichages
4 K
patricktoulon
patricktoulon
S
  • Question Question
XL 2016 Macro pour Envoyer des mails aves des pièces jointes
Réponses
9
Affichages
2 K
zebanx
zebanx
R
  • Question Question
XL 2019 lister fichier avec exifs ou propriétés
Réponses
1
Affichages
2 K
fanch55
fanch55
R
  • Résolu(e)
XL 2016 Lister fichiers avec Exifs et propriétés (suivant son choix) - code à modifier
10 11 12
Réponses
167
Affichages
17 K
re4
R
M
  • Question Question
XL 2016 listes des fichiers
Réponses
8
Affichages
1 K
sylvanu
sylvanu
dysorthographie
  • Suggestion Suggestion
Recherche & référence FS0(S)
Réponses
4
Affichages
2 K
Bernard_XLD
Bernard_XLD
L
  • Question Question
XL 2019 Code VBA, chercher un fichier et mettre hyperlink dans cellule correspondante
Réponses
5
Affichages
1 K
laktats
L
maval
  • Question Question
XL 2013 Donnée un nom à une image sur Formulaire
Réponses
13
Affichages
1 K
patricktoulon
patricktoulon
O
  • Question Question
XL 2013 Macro pour recopier des fichiers
2
Réponses
27
Affichages
3 K
patricktoulon
patricktoulon
X
  • Question Question
XL 2010 Déplacement de fichiers dans des dossiers portant le même nom
Réponses
7
Affichages
2 K
xamenod
X
M
  • Question Question
import fichiers txt excel bug
2
Réponses
17
Affichages
3 K
matlatarte
M
C
  • Question Question
Exclure les fichiers cachés avec GetFolder
Réponses
4
Affichages
2 K
Chri8Ed
C
F
  • Question Question
XL 2010 Code VBA propriéte d'un fichier d'un repertoire
Réponses
7
Affichages
4 K
Staple1600
Staple1600
Retour