XL 2010 VBA - Lister fichiers et décortiquer le nom des fichiers dans colonne A et B

tchi456

XLDnaute Occasionnel
Bonjour,

Je recherche un code à mettre sur un bouton qui me permette de sélectionner un dossier et de lister tous les fichiers de ce dossier et décortiquer le texte de ces fichiers.

Dans la majorité des cas les fichiers sont nommés comme ceci: NOM - Prénom.pdf et je souhaiterais pouvoir séparer les "NOMS" (colonne A) et les "Prénoms" (colonne B).
Le problème c'est que je peux avoir des NOMS et des Prénoms composés avec un "-" mais j'aimerais qu'il me sépare le texte quand il y a " - " (espace, tiret, espace) et non pas uniquement un tiret.

Exemple:

Si un de mes nombreux fichiers est nommé "VON BERGEN - Jean-Philippe.pdf", je souhaiterais qu'il me sépare le texte en colonne A "VON BERGEN" et en colonne B "Jean-Philippe".

Pouvez-vous m'aider?

Mes meilleures salutations,

Thierry
 

Pièces jointes

  • Test.xlsx
    14.3 KB · Affichages: 3
Solution
Bonjour Tchi,
Un essai en PJ avec :
Code:
Sub BoucleFichiers()
    Dim Chemin$, Fichier$, L%, T
    [A:B].ClearContents
    Chemin = "C:\Users\PC_PAPA\Desktop\XLD\Ludo\"  'Définit le répertoire contenant les fichiers, doit se terminer par \
    'Boucle sur tous les fichiers pdf du répertoire.
    Fichier = Dir(Chemin & "*.pdf")
    L = 1
    Do While Len(Fichier) > 0
        'Sépare le nom avec " - " et range les nom et prénoms
        T = Split(Mid(Fichier, 1, Len(Fichier) - 4), " - ")
        Cells(L, "A") = T(0)
        On Error Resume Next ' Dans le cas où " - " est introuvable
        Cells(L, "B") = T(1)
        L = L + 1
        Fichier = Dir()
    Loop
End Sub
Le chemin doit être évidemment modifié. Il doit se terminer par "\"

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Tchi,
Un essai en PJ avec :
Code:
Sub BoucleFichiers()
    Dim Chemin$, Fichier$, L%, T
    [A:B].ClearContents
    Chemin = "C:\Users\PC_PAPA\Desktop\XLD\Ludo\"  'Définit le répertoire contenant les fichiers, doit se terminer par \
    'Boucle sur tous les fichiers pdf du répertoire.
    Fichier = Dir(Chemin & "*.pdf")
    L = 1
    Do While Len(Fichier) > 0
        'Sépare le nom avec " - " et range les nom et prénoms
        T = Split(Mid(Fichier, 1, Len(Fichier) - 4), " - ")
        Cells(L, "A") = T(0)
        On Error Resume Next ' Dans le cas où " - " est introuvable
        Cells(L, "B") = T(1)
        L = L + 1
        Fichier = Dir()
    Loop
End Sub
Le chemin doit être évidemment modifié. Il doit se terminer par "\"
 

Pièces jointes

  • Test (8).xlsm
    16.7 KB · Affichages: 2
Dernière édition:

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re,
Et si vous voulez demander quel dossier traiter, alors remplacer par :
VB:
Sub BoucleFichiers()
    Dim Chemin$, Fichier$, L%, T, Dossier As FileDialog
    [A:B].ClearContents
    ' Demande quel dossier traiter
    Set Dossier = Application.FileDialog(msoFileDialogFolderPicker)
    Dossier.Show
    If Dossier.SelectedItems.Count > 0 Then Chemin = Dossier.SelectedItems(1) & "\"
    'Boucle sur tous les fichiers pdf du répertoire.
    Fichier = Dir(Chemin & "*.pdf")
    L = 1
    Do While Len(Fichier) > 0
        'Sépare le nom avec " - " et range les nom et prénoms
        T = Split(Mid(Fichier, 1, Len(Fichier) - 4), " - ")
        Cells(L, "A") = T(0)
        On Error Resume Next ' Dans le cas où le nom du fichier ne comporte pas " - "
        Cells(L, "B") = T(1)
        L = L + 1
        Fichier = Dir()
    Loop
End Sub
 

tchi456

XLDnaute Occasionnel
Bonjour Sylvanu,

Je n'ai rien à ajouter mis à part que votre code fonctionne parfaitement bien.
Je vous remercie beaucoup pour votre aide; je n'aurais jamais été capable de trouver ça tout seul.

Mes meilleures salutations et bonne fin de semaine,

Thierry
 

Discussions similaires

Statistiques des forums

Discussions
312 211
Messages
2 086 299
Membres
103 172
dernier inscrit
Aurelyan