Discussion :

[trach.sam]

ce petit bout de programme que j'ai modifie avec du code a gauche a droite ne fonctionne pas !

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub BrowseFiles(Path As String)
    Filename = Dir(Path, vbDirectory)
    Do While Filename <> ""
        If Filename <> "." And Filename <> ".." Then
            rep = (GetAttr(Path & Filename) And vbDirectory) = vbDirectory
            If rep Then
                BrowseFiles (Path & Filename & "\")
            Else
                Debug.Print Path & "   " & Filename
            End If
        End If
        Filename = Dir    ' Extrait l'entrée suivante.
    Loop
End Sub

je soupsone qu'on ne puisse pas faire du recursif en VBA ?

[trach.sam]

Voici ma reponse

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
Sub sam()
    Dim TabDir As New Collection
    TabDir.Add ("x:\")
 
    BrowseFiles TabDir
End Sub
 
Sub BrowseFiles(TabDir As Collection)
    cmp = TabDir.Count
    If cmp = 0 Then
     Exit Sub
    Else
        Path = TabDir.Item(cmp)
        Filename = Dir(Path, vbDirectory)
        Do While Filename <> ""
            If Filename <> "." And Filename <> ".." Then
                rep = (GetAttr(Path & Filename) And vbDirectory) = vbDirectory
                If rep Then
                    TabDir.Add Path & Filename & "\"
                Else
                    Debug.Print Path & "   " & Filename
                End If
            End If
            Filename = Dir ' Extrait l'entrée suivante.
        Loop
        TabDir.Remove (cmp)
    End If
    BrowseFiles TabDir
End Sub

quand on est null on fait comme on peut

[trach.sam]

Je tenais a donner ca au prochain lecteur
liens super util

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
Sub newBrowseFilesHat(TabDir As Collection, pos As Integer)
If pos Mod 100 = 0 Then
MsgBox "et de 100"
End If
 
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objShell = CreateObject("Shell.Application")
 
    cmp = TabDir.Count
    If cmp = 0 Then
     MsgBox "Well done"
     Exit Sub
    Else
        Path = TabDir.Item(cmp)
        Set objFolder = objShell.Namespace(Path)
        For Each Filename In objFolder.Items
            If objFolder.GetDetailsOf(Filename, 2) = "File Folder" Then
                TabDir.Add Path & Filename & "\"
            Else
            Cells(pos, "A") = Path
            Cells(pos, "B") = Filename
            Cells(pos, "C") = objFolder.GetDetailsOf(Filename, 8)
            Cells(pos, "D") = objFolder.GetDetailsOf(Filename, 9)
            Cells(pos, "E") = objFolder.GetDetailsOf(Filename, 3)
            Cells(pos, "F") = objFolder.GetDetailsOf(Filename, 4)
            Cells(pos, "G") = objFolder.GetDetailsOf(Filename, 5)
            pos = pos + 1
            End If
        Next
    TabDir.Remove (cmp)
    End If
    newBrowseFilesHat TabDir, pos
End Sub