Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Macro Excel de parcours récursif d'arborescence

Macro Excel de parcours récursif d'arborescence

3 réponses
Avatar
lediablotin
Bonjour =E0 tous,

Je d=E9bute dans les macro Excel pour les besoins de mon travail, et
j'aurais besoin de r=E9cup=E9rer dans la colonne A le nom des
r=E9pertoires et dans la colonne B le nom des fichiers (sans leur
extension) que chacun d'eux contient.

J'ai donc =E9crit ceci :

Sub ListeFic()
Set objShell =3D CreateObject("Shell.Application")
Set objFolder =3D objShell.BrowseForFolder(&H0&, "Choisissez un
r=E9pertoire sioupl=E9 :", &H1&)
On Error Resume Next
Chemin =3D objFolder.ParentFolder.ParseName(objFolder.Title).Path &
""
If objFolder.Title =3D "Bureau" Then
Chemin =3D "C:\Windows\Bureau"
End If
If objFolder.Title =3D "" Then
Chemin =3D ""
End If
MsgBox (Chemin)
ListerRepertoire (Chemin,1)
End Sub
---------------------------------------------------------------------------=
----------------------------
Private Sub ListerRepertoire(CheminRep As String, iLigne As Integer)
Dim fs
Dim Repertoire
Dim Fi
Dim Fo
Dim NumLigne As Integer
NumLigne =3D iLigne
Set fs =3D CreateObject("Scripting.FileSystemObject")
Set Repertoire =3D fs.GetFolder(CheminRep)
'Lister les noms des Fichiers
For Each Fi In Repertoire.Files
Sheet1.Range("A" & NumLigne).Value =3D Repertoire.Name
Sheet1.Range("B" & NumLigne).Value =3D Fi.Name
NumLigne =3D NumLigne + 1
Next

'Lister les noms des sous-repertoires et des fichiers qu'ils
contiennent
For Each Fo In Repertoire.SubFolders
ListerRepertoire (Repertoire & Fo.Name, NumLigne)
'Sheet1.Range("C" & NumLigne).Value =3D Fo.Name
'NumLigne =3D NumLigne + 1
Next

Set Repertoire =3D Nothing
Set fs =3D Nothing
End Sub

Pour faire un parcours r=E9cursif de l'arborescence depuis un
r=E9pertorie de mon choix.
Mon probl=E8me est tout smiplement que ce code ne me remonte que les
fichiers du r=E9pertoire que j'ai choisi, et pas le reste. J'ai essay=E9
tout un tas d'autres solutions, je n'y parviens pas.

Pouvez-vous me dire o=F9 j'ai fait boulette ?

En vous remerciant de votre aide,

Le Diablotin :)
Signaler un problème avec ce contenu

3 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Ilan
Bonjour, pour obtenir ce que tu cherches il te faut récuppérer la liste des
fichiers des sous-répertoires de ton arborescence.
Exemple :
For Each Fo In Repertoire.SubFolders
Set SousRepertoire=fs.GetFolders(CheminRep & "" & Fo.Name)
For Each Fi In SousRepertoire.Files

Next
Next

Exemple :

Private Sub ListerRepertoire(CheminRep As String, iLigne As Integer)
Dim fs
Dim Repertoire, SousRepertoire
Dim Fi
Dim Fo
Dim NumLigne As Integer
NumLigne = iLigne
Set fs = CreateObject("Scripting.FileSystemObject")
Set Repertoire = fs.GetFolder(CheminRep)
'Lister les noms des Fichiers
For Each Fi In Repertoire.Files
Sheet1.Range("A" & NumLigne).Value = Repertoire.Name

NumLigne = NumLigne + 1
Next

'Lister les noms des sous-repertoires et des fichiers qu'ils
contiennent
For Each Fo In Repertoire.SubFolders
ListerRepertoire (Repertoire & Fo.Name, NumLigne)
'Sheet1.Range("C" & NumLigne).Value = Fo.Name
'NumLigne = NumLigne + 1
Next

Set Repertoire = Nothing
Set fs = Nothing
End Sub




Bonjour à tous,

Je débute dans les macro Excel pour les besoins de mon travail, et
j'aurais besoin de récupérer dans la colonne A le nom des
répertoires et dans la colonne B le nom des fichiers (sans leur
extension) que chacun d'eux contient.

J'ai donc écrit ceci :

Sub ListeFic()
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisissez un
répertoire siouplé :", &H1&)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path &
""
If objFolder.Title = "Bureau" Then
Chemin = "C:WindowsBureau"
End If
If objFolder.Title = "" Then
Chemin = ""
End If
MsgBox (Chemin)
ListerRepertoire (Chemin,1)
End Sub
-------------------------------------------------------------------------------------------------------
Private Sub ListerRepertoire(CheminRep As String, iLigne As Integer)
Dim fs
Dim Repertoire
Dim Fi
Dim Fo
Dim NumLigne As Integer
NumLigne = iLigne
Set fs = CreateObject("Scripting.FileSystemObject")
Set Repertoire = fs.GetFolder(CheminRep)
'Lister les noms des Fichiers
For Each Fi In Repertoire.Files
Sheet1.Range("A" & NumLigne).Value = Repertoire.Name
Sheet1.Range("B" & NumLigne).Value = Fi.Name
NumLigne = NumLigne + 1
Next

'Lister les noms des sous-repertoires et des fichiers qu'ils
contiennent
For Each Fo In Repertoire.SubFolders
ListerRepertoire (Repertoire & Fo.Name, NumLigne)
'Sheet1.Range("C" & NumLigne).Value = Fo.Name
'NumLigne = NumLigne + 1
Next

Set Repertoire = Nothing
Set fs = Nothing
End Sub

Pour faire un parcours récursif de l'arborescence depuis un
répertorie de mon choix.
Mon problème est tout smiplement que ce code ne me remonte que les
fichiers du répertoire que j'ai choisi, et pas le reste. J'ai essayé
tout un tas d'autres solutions, je n'y parviens pas.

Pouvez-vous me dire où j'ai fait boulette ?

En vous remerciant de votre aide,

Le Diablotin :)




Avatar
Le Diablotin

Bonjour, pour obtenir ce que tu cherches il te faut récuppérer la lis te des
fichiers des sous-répertoires de ton arborescence.
Exemple :
For Each Fo In Repertoire.SubFolders
Set SousRepertoire=fs.GetFolders(CheminRep & "" & Fo.Name)
For Each Fi In SousRepertoire.Files

Next
Next

Exemple :

Private Sub ListerRepertoire(CheminRep As String, iLigne As Integer)
Dim fs
Dim Repertoire, SousRepertoire
Dim Fi
Dim Fo
Dim NumLigne As Integer
NumLigne = iLigne
Set fs = CreateObject("Scripting.FileSystemObject")
Set Repertoire = fs.GetFolder(CheminRep)
'Lister les noms des Fichiers
For Each Fi In Repertoire.Files
Sheet1.Range("A" & NumLigne).Value = Repertoire.Name

NumLigne = NumLigne + 1
Next

'Lister les noms des sous-repertoires et des fichiers qu'ils
contiennent
For Each Fo In Repertoire.SubFolders
ListerRepertoire (Repertoire & Fo.Name, NumLigne)
'Sheet1.Range("C" & NumLigne).Value = Fo.Name
'NumLigne = NumLigne + 1
Next

Set Repertoire = Nothing
Set fs = Nothing
End Sub




Bonjour à tous,

Je débute dans les macro Excel pour les besoins de mon travail, et
j'aurais besoin de récupérer dans la colonne A le nom des
répertoires et dans la colonne B le nom des fichiers (sans leur
extension) que chacun d'eux contient.

J'ai donc écrit ceci :

Sub ListeFic()
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisissez un
répertoire siouplé :", &H1&)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path &
""
If objFolder.Title = "Bureau" Then
Chemin = "C:WindowsBureau"
End If
If objFolder.Title = "" Then
Chemin = ""
End If
MsgBox (Chemin)
ListerRepertoire (Chemin,1)
End Sub
----------------------------------------------------------------------- --------------------------------
Private Sub ListerRepertoire(CheminRep As String, iLigne As Integer)
Dim fs
Dim Repertoire
Dim Fi
Dim Fo
Dim NumLigne As Integer
NumLigne = iLigne
Set fs = CreateObject("Scripting.FileSystemObject")
Set Repertoire = fs.GetFolder(CheminRep)
'Lister les noms des Fichiers
For Each Fi In Repertoire.Files
Sheet1.Range("A" & NumLigne).Value = Repertoire.Name
Sheet1.Range("B" & NumLigne).Value = Fi.Name
NumLigne = NumLigne + 1
Next

'Lister les noms des sous-repertoires et des fichiers qu'ils
contiennent
For Each Fo In Repertoire.SubFolders
ListerRepertoire (Repertoire & Fo.Name, NumLigne)
'Sheet1.Range("C" & NumLigne).Value = Fo.Name
'NumLigne = NumLigne + 1
Next

Set Repertoire = Nothing
Set fs = Nothing
End Sub

Pour faire un parcours récursif de l'arborescence depuis un
répertorie de mon choix.
Mon problème est tout smiplement que ce code ne me remonte que les
fichiers du répertoire que j'ai choisi, et pas le reste. J'ai essay é
tout un tas d'autres solutions, je n'y parviens pas.

Pouvez-vous me dire où j'ai fait boulette ?

En vous remerciant de votre aide,

Le Diablotin :)




Bonjour Ilan, et merci de ta réponse :)
Alors maintenant, je voudrais récupérer le nom des fichiers, mais
sans leur extension ...

Voici mon code après ce que tu m'as proposé :

Sub ListeFic()
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisissez un
répertoire siouplé :", &H1&)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path &
""
MsgBox ("Listage du répetoire : " & Chemin)
ListerRepertoire (Chemin)
End Sub
--------------------------------------------------------------------------- -------
Private Sub ListerRepertoire(CheminRep As String)
Dim fs
Dim Repertoire
Dim SousRepertoire
Dim Fi
Dim Fo
Dim NumLigne As Integer
NumLigne = 2
Set fs = CreateObject("Scripting.FileSystemObject")

' On récupère les fichiers qui sont dans le répertoire choisi
Set Repertoire = fs.GetFolder(CheminRep)

'Lister les noms des Fichiers dans le répertoire choisi
For Each Fi In Repertoire.Files
ActiveSheet.Range("A" & NumLigne).Value = Repertoire.Name
ActiveSheet.Range("B" & NumLigne).Value = Fi.Name
NumLigne = NumLigne + 1
Next
MsgBox ("Listage des sous-repertoires")
'Lister les sous-repertoires
For Each Fo In Repertoire.SubFolders
Set SousRepertoire = fs.GetFolder(Fo)
For Each Fic In SousRepertoire.Files
ActiveSheet.Range("A" & NumLigne).Value =
SousRepertoire.Name
ActiveSheet.Range("B" & NumLigne).Value = Fic.Name
NumLigne = NumLigne + 1
Next
Next
Range(A1).Select
Set Repertoire = Nothing
Set SousRepertoire = Nothing
Set fs = Nothing
End Sub

Donc soit il va falloir que je fasse un traitment pour attraper l'index
du point et supprimer ce qui est après, soit attraper une fonction
Excel qui fasse la même chose :)

Quelle est la façon la plus élégante de faire ceci ?

En vous remerciant,

Le Diablotin :)


Avatar
Ilan
Bonjour, l'extension sont les trois caractères du nom de fichier qui sont
précédés d'un "." . Tu ne récupères donc que la partie gauche du nom de
fichier qui précède le dernier caractère "." s'il existe.

Exemple :
IF InstrRev(Fic.Name,".")>0 Then
ActiveSheet.Range("B" &
NumLigne).Value=Left(Fic.Name,instrRev(Fic.name,".")-1)
ELSE
ActiveSheet.Range("B" & NumLigne).Value=Fic.Name