Listage de fichier - Limite de 32000

**polonpolo** · 13/04/2010, 15h36

Bonjour,
J'ai modifié le code donné en exemple pour lister les répertoires et sous-répertoires.
Mais la liste se limite à 32000 fichiers.
Y-a-t-il moyen de passer outre ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
Option Explicit
Dim i As Integer
Dim Cible As Byte
 
 
Sub listeDossiersEtSousDossiers(Racine As String)
    Application.ScreenUpdating = False
 
    i = 3
    Cible = NbSeparateur(Racine)
    ListeDossiers Racine
 
    Application.ScreenUpdating = True
End Sub
 
 
Sub ListeDossiers(NomRep As String)
    Dim Fso As Object
    Dim SourceFolder As Object
    Dim SourceFile As Object
    Dim SubFolder As Object
    Dim File As Object
 
    On Error GoTo Fin
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(NomRep)
 
    For Each SubFolder In SourceFolder.SubFolders
 
'        --------------- Pour afficher une ligne vide avec le répertoire seul avant les fichiers
'                        Si non les répertoires vides ne figure pas
'        i = i + 1
'        Cells(i, 2) = SubFolder.Path
'        Cells(i, 4) = SubFolder.Size
'        Cells(i, 5) = SubFolder.DateLastModified
        For Each File In SubFolder.Files
 
            i = i + 1
            Cells(i, 2) = SubFolder.Path
            Cells(i, 3) = File.Name
            Cells(i, 4) = File.Size
            Cells(i, 5) = File.DateLastModified
        Next File
        ListeDossiers SubFolder.Path
    Next SubFolder
 
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
 
    NbSeparateur = Nb
End Function