Public idx As Double, Lecteur
Sub Liste_Dossiers()
t1 = Timer
On Error Resume Next
'Cells(1, 2).Value = "Macro test2"
idx = 2
Application.ScreenUpdating = False
Sheets.Add
Lecteur = InputBox("lecteur à scanner?")
TousLesDossiers2 Lecteur & ":\", 0
Application.StatusBar = Format(Timer - t1, "0,0" & " secondes pour Lister les dossiers")
derl = [A65536].End(xlUp).Row
Range(Cells(1, 1), Cells(derl, 1)).Select
Liste_Fichiers_Dossier_droite
Application.ScreenUpdating = True
End Sub
Sub TousLesDossiers2(LeDossier$, idx As Long)
Dim FSO As Object, Dossier As Object
Dim sousRep As Object, Flder As Object
Dim Fichier As Object, Chemin As String
On Error Resume Next
Application.ScreenUpdating = False
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Dossier = FSO.GetFolder(LeDossier)
'examen du dossier courant
For Each Flder In Dossier.subfolders
idx = idx + 1
Cells(idx, 1).Value = Flder.Path
Next
'traitement récursif des sous dossiers
For Each sousRep In Dossier.subfolders
TousLesDossiers2 sousRep.Path, idx
'idx = idx + 1
Next
Set FSO = Nothing
suite:
End Sub
Sub Liste_Fichiers()
'http://forum.hardware.fr/hfr/Programmation/VB-VBA-VBS/liste-fichiers-repertoire-sujet_57846_1.htm
'ChDir "C:\...Mon chemin....\Mes documents"
'Range("2:1000").Clear
On Error Resume Next
Range(Cells(2, 1), Cells(65536, 1)).Clear
Dim i As Integer, z As String
ChDrive Left(Cells(1, 2), 1)
ChDir Cells(1, 2).Value
i = 1
z = Dir("*.txt", 1)
While z <> ""
ActiveSheet.Cells(i + 1, 1).Value = z
i = i + 1
z = Dir
Wend
End Sub
Sub Liste_Fichiers_Dossier_droite()
'http://forum.hardware.fr/hfr/Programmation/VB-VBA-VBS/liste-fichiers-repertoire-sujet_57846_1.htm
'ChDir "C:\...Mon chemin....\Mes documents"
'Range("2:1000").Clear
'Range(Cells(2, 1), Cells(65536, 1)).Clear
t1 = Timer
i = 1
On Error Resume Next
For Each cell In Selection
'Dim i As Integer, z As String
ChDrive Left(Cells(cell.Row, 1), 1)
ChDir Cells(cell.Row, 1).Value
z = Dir("*", 1)
While z <> ""
ActiveSheet.Cells(cell.Row, i + 1).Value = z
i = i + 1
z = Dir
Wend
i = 1
Next
ActiveSheet.Name = Lecteur & " " & Format(Date, "DD MM YYYY")
MsgBox Timer - t1
End Sub