Pour les rétifs du Dos
Voici le source d'une macro Excel à modifier selon les besoins...
Sub Liste_triée()
' permet de Lister un dossier avec ses sous-dossiers et ses fichiers en respectant physiquement l'ordre alphabétique
'
Do
In_path = InputBox("chemin du dossier lister" & vbLf & "par exemple :", "reclassement", "E:\outil_accessoires\" )
If In_path = "" Then Exit Sub
If Right(In_path, 1) <> "\" Then In_path = In_path & "\"
If Dir(In_path, vbDirectory) = "" Then MsgBox "Le dossier à lister ==> " & In_path & vbLf & "n'existe pas, merci de corriger "
Loop Until Dir(In_path, vbDirectory) <> ""
outliste = InputBox("Nom du fichier contenant la liste" & vbLf & "par exemple :", "Liste classée", "E:\essai\liste" )
If outliste = "" Then Exit Sub
If Right(outliste, 4) <> ".txt" Then outliste = outliste & ".txt"
If Dir(outliste, vbDirectory) <> "" Then
If MsgBox("Le fichier de sortie ==> " & outliste & vbLf & "existe déjà, Voulez-vous l'écraser ", vbOKCancel) <> vbOK Then Exit Sub
If Dir(outliste, vbDirectory) <> "" Then Kill outliste
End If
i_niveau = 0 ' profondeur des dossiers
i_row = 2
'RAZ colonnes de travail
Columns("A:E" ).Select
Selection.Delete Shift:=xlToLeft
Cells(1, 1) = "dir"
Cells(1, 2) = 0
Cells(1, 3) = In_path
Do While Cells(1, 1) = "dir"
i_niveau = i_niveau + 1
Cells(1, 2) = i_niveau
In_path = Cells(1, 3)
MyName = Dir(In_path, vbDirectory + vbHidden + vbNormal + vbSystem)
Do While MyName <> "" ' Commence la boucle.
' Ignore le répertoire courant et le répertoire
' contenant le répertoire courant.
If MyName <> "." And MyName <> ".." Then
Rows(i_row).Insert
Cells(i_row, 2) = i_niveau
' Utilise une comparaison au niveau du bit pour
' vérifier que MyName est un répertoir
If (GetAttr(In_path & MyName) _
And vbDirectory) = vbDirectory Then
' représente un répertoire.
Cells(i_row, 1) = "dir"
Cells(i_row, 3) = In_path & MyName & "\"
Cells(i_row, 4) = Chr(0)
i_row = i_row + 1
Else
' représente un fichier
Cells(i_row, 1) = "file_" ' & i_niveau
Cells(i_row, 3) = In_path & Chr(255)
Cells(i_row, 4) = MyName
i_row = i_row + 1
End If
End If
MyName = Dir ' Extrait l'entrée suivante.
Loop
Cells(1, 1) = "Dir_Ok" 'indication que le dossier a été traité
Worksheets(1).Range("A1" ).Sort _
Key1:=Worksheets(1).Columns("A" ), Key2:=Worksheets(1).Columns("B" ), Key3:=Worksheets(1).Columns("C" )
Loop
Worksheets(1).Range("A1" ).Sort _
Key1:=Worksheets(1).Columns("C" ), Key2:=Worksheets(1).Columns("D" )
' compteur de création de dossiers
i_Dir = -1 ' on ne copte pas le dossier de plus haut niveau
' compteur de recopie de fichiers
i_File = 0
Open outliste For Output Shared As #1
Print #1, "Traitement exécuté le " & Format(Date, "dddd d mmm yyyy" ) & " à " & Format(Time, "h:m:s" )
Print #1, vbCrLf & "==========================================================="
Print #1, vbCrLf & "Début de la liste des fichiers triée" & vbCrLf
i = 1
Do Until Cells(i, 1) = ""
If Left(Cells(i, 1), 3) = "Dir" Then
Print #1, " Répertoire ==> " & Cells(i, 3)
i_Dir = i_Dir + 1
Else
Print #1, " Fichier ==> " & Left(Cells(i, 3), Len(Cells(i, 3)) - 1) & Cells(i, 4)
i_File = i_File + 1
End If
i = i + 1
Loop
MsgBox "nombre de dossiers listés : " & i_Dir & vbCrLf & _
"nombre de fichiers listés : " & i_File, vbOKOnly, "liste classée"
Print #1, vbCrLf & "Fin de la liste"
appl = "notepad.exe" & " " & outliste
Close #1
outliste = "e:\essai\liste.txt"
appl = "c:\windows\notepad.exe " & """" & outliste & """"
RetVal = Shell(appl, 4)
Workbooks(1).Close SaveChanges:=False
End Sub