Extraire liste sous dossier d'un dossier de Silkyroad

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

Ce sujet a été automatiquement fermé après 30 jours. Aucune réponse n’est permise dorénavant.