Bonjour,
La macro proposée par Silkyroad ci-dessous fonctionne très bien, cependant je souhaiterais :
1- N’afficher que le premier niveau de sous-dossier (pas les sous-dossiers des sous-dossiers, …)
2- Classer les résultats par ordre alphabétique.
Quelles modifs dois-je apporter à ce code ? Merci par avance.
Voici le code proposé par Silkyroad :
Option Explicit
Dim i As Integer
Dim Cible As Byte
Sub listeDossiersEtSousDossiers()
Dim Racine As String
Application.ScreenUpdating = False
Racine = "C:\Documents and Settings\mimi\dossier"
Cible = nbSeparateur(Racine)
ListeReps Racine, True
Application.ScreenUpdating = True
i = 0
End Sub
Sub ListeReps(strDossier As String, strSousDossier As Boolean)
’ adapté de Ole P Erlandsen
Dim Fso As Object, SourceFolder As Object
Dim SubFolder As Object
On Error GoTo Fin
Set Fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = Fso.GetFolder(strDossier)
If strSousDossier Then
For Each SubFolder In SourceFolder.subfolders
i = i + 1
'pour recuperer le chemin complet
'Cells(i, nbSeparateur(SubFolder.Path) - Cible) = SubFolder.Path
'
'pour recuperer uniquement le nom du dossier
Cells(i, nbSeparateur(SubFolder.Path) - Cible) = SubFolder.Name
ListeReps SubFolder.Path, strSousDossier
Next SubFolder
End If
Fin:
End Sub
Function nbSeparateur(Chemin As String) As Byte
Dim m As Integer
Dim Nb As Byte
For m = 1 To Len(Chemin)
If Mid(Chemin, m, 1) = "\" Then
Nb = Nb + 1
m = m + 1
End If
Next m
nbSeparateur = Nb
End Function