Public Chemin As String, dossier, TableauListeDossierEncours, T1
Sub Liste_Dossier_Select()
T1 = Timer
NomAScanner = ActiveCell.Text: If NomAScanner = "" Then Exit Sub
Sheets.Add: Nom1 = Replace(NomAScanner, ":", " "): Nom2 = Replace(Nom1, "\", " "): If Len(Nom2) < 31 Then ActiveSheet.Name = Nom2 Else ActiveSheet.Name = Mid(Nom2, 1, 31)
Cells(1, 1).Value = NomAScanner
Liste_Dossier_Sous_Dossiers_OK
'Stop
'Ajouter ordre et alea
Derl = Cells(Rows.Count, 1).End(xlUp).Row
'AjouterCode
Selection.AutoFilter
Selection.AutoFilter
Application.StatusBar = Format(Timer - T1, "0.0") & " secondes"
End Sub
Sub Liste_Dossier_Sous_Dossiers_OK()
Application.ScreenUpdating = False
Set F = ActiveSheet
If F.FilterMode Then F.ShowAllData
If Not F.AutoFilterMode Then F.Range("A1").AutoFilter
Range(Cells(2, 1), Cells(Rows.Count, 10)).Clear
Dim TableauListeDossier(1000000)
dossier = [A1]
Liste_Dossiers_SousDossiers
Derl = Cells(Rows.Count, 1).End(xlUp).Row: If Derl = 1 Then Derl = 2
'Stop
For i = 1 To Derl
TableauListeDossier(i) = Cells(i, 1).Value
Next
'Stop
Range(Cells(2, 1), Cells(Derl, 10)).Clear
For i = 1 To Derl
TableauListeDossierEncours = TableauListeDossier(i)
ListeFichierDossierEnCours (TableauListeDossier(i))
Next
'Tri_Desc_Date
Application.ScreenUpdating = True
'MsgBox Format(Timer - t1, "0.0")
MEF_ListeFichiers
End Sub
Sub TousLesDossiers(LeDossier$, Idx As Long)
Dim fso As Object, dossier As Object
Dim sousRep As Object, Flder As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set dossier = fso.GetFolder(LeDossier)
'examen du dossier courant
On Error Resume Next
Idx = Cells(Rows.Count, 1).End(xlUp).Row + 1
For Each Flder In dossier.subfolders
Cells(Idx, 1).Value = Flder.Path
Idx = Idx + 1
Next
'traitement récursif des sous dossiers
For Each sousRep In dossier.subfolders
TousLesDossiers sousRep.Path, Idx
Next sousRep
Set fso = Nothing
End Sub 'fs
Sub Liste_Dossiers_SousDossiers()
'TousLesDossiers "D:\LUI\Developement\VB_VBA\", 0
TousLesDossiers [A1], 0
'Tableau de chaque dossier puis listage de chaque dossier
End Sub
Sub ListeFichierDossierEnCours(Chemin As String)
Dim dossier As Object, Fichier As Object
Dim i As Long
'Chemin du dossier à analyser (à adapter au besoin)
'Chemin = ThisWorkbook.Path
'Chemin = ActiveSheet.Range("A1").Value 'Sheets("paramètrage").Range("b5").Value
'Définition de la variable
On Error Resume Next
If Chemin = "" Then Exit Sub
Set dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
' Boucle sur les fichiers
'Range("a2").Select
' Stop
i = Cells(Rows.Count, 1).End(xlUp).Row + 1
For Each Fichier In dossier.Files
Cells(i, 1).Formula = TableauListeDossierEncours
'Cells(i, 1).Formula = Fichier.Path
'Cells(i, 1).Formula = Range("A1").Value
Cells(i, 2).Formula = Fichier.Name
Cells(i, 3).Formula = Fichier.Size
Cells(i, 4).Formula = Fichier.DateLastModified 'DateCreated'DateLastAccessed
i = i + 1
Next
End Sub
Sub MEF_ListeFichiers()
'Columns("B:D").Select
'Columns("B:D").EntireColumn.AutoFit
'Columns("A:A").Select
Columns("A:B").ColumnWidth = 40
Columns("C:D").ColumnWidth = 20
Range("B1").Select
ActiveCell.FormulaR1C1 = "Nom"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Taille"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Date"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Ordre"
Range("F1").Select
ActiveCell.FormulaR1C1 = "Aléatoire"
Range("F1").Select
Range(Selection, Selection.End(xlToLeft)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Columns("C:D").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Font.Bold = False
Columns("E:F").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Font.Bold = False
'Range("C").Select
With Range("C:C")
.HorizontalAlignment = xlRight 'xlLeft'xlcenter
.VerticalAlignment = xlCenter
.NumberFormat = "#,##0"
End With
Range("B1").Select
End Sub
