Comment répertorier tous les dossiers et sous-dossiers dans Excel?

Avez-vous déjà souffert de ce problème qui répertorie tous les dossiers et sous-dossiers d'un répertoire spécifié dans une feuille de calcul? Dans Excel, il n'existe pas de moyen rapide et pratique d'obtenir le nom de tous les dossiers d'un répertoire spécifique à la fois. Pour faire face à la tâche, cet article peut vous aider.

Lister tous les dossiers et sous-dossiers avec le code VBA

Lister tous les dossiers et sous-dossiers avec le code VBA

Si vous souhaitez obtenir tous les noms de dossier à partir d'un répertoire spécifié, le code VBA suivant peut vous aider, procédez comme suit:

1. Maintenez le ALT + F11 clés, et il ouvre le Fenêtre Microsoft Visual Basic pour Applications.

2Cliquez sur insérer > Moduleet collez le code suivant dans le Fenêtre du module.

Code VBA: liste tous les noms de dossiers et de sous-dossiers

Sub FolderNames()
'Updateby Extendoffice
Application.ScreenUpdating = False
Dim xPath As String
Dim xWs As Worksheet
Dim fso As Object, j As Long, folder1 As Object
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Choose the folder"
    .Show
End With
On Error Resume Next
xPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"
Application.Workbooks.Add
Set xWs = Application.ActiveSheet
xWs.Cells(1, 1).Value = xPath
xWs.Cells(2, 1).Resize(1, 5).Value = Array("Path", "Dir", "Name", "Date Created", "Date Last Modified")
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder1 = fso.getFolder(xPath)
getSubFolder folder1
xWs.Cells(2, 1).Resize(1, 5).Interior.Color = 65535
xWs.Cells(2, 1).Resize(1, 5).EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub
Sub getSubFolder(ByRef prntfld As Object)
Dim SubFolder As Object
Dim subfld As Object
Dim xRow As Long
For Each SubFolder In prntfld.SubFolders
    xRow = Range("A1").End(xlDown).Row + 1
    Cells(xRow, 1).Resize(1, 5).Value = Array(SubFolder.Path, Left(SubFolder.Path, InStrRev(SubFolder.Path, "\")), SubFolder.Name, SubFolder.DateCreated, SubFolder.DateLastModified)
Next SubFolder
For Each subfld In prntfld.SubFolders
    getSubFolder subfld
Next subfld
End Sub

3. Puis appuyez F5 clé pour exécuter ce code, et un Choisissez le dossier La fenêtre apparaîtra, puis vous devez sélectionner le répertoire dans lequel vous souhaitez répertorier les noms de dossier et de sous-dossier, voir capture d'écran:

4Cliquez sur OK, et vous obtiendrez le chemin du dossier et des sous-dossiers, le répertoire, le nom, la date de création et la date de dernière modification dans un nouveau classeur, voir capture d'écran:

Article connexe:

Comment répertorier les fichiers d'un répertoire dans une feuille de calcul dans Excel?