Voici le code d'une source de Vbfrance qui permet cette fonction:
Private Sub GetDirTree(Drive)
Dim DirStr As Variant
Dim cntDir As Integer
Dim OK As Boolean
Dim i1, i2, i3 As Integer
Dim S1, S2, S3 As String
List1.Clear
List1.Visible = True
S1 = Dir(Drive, vbDirectory)
While S1 > ""
If (S1 <> ".") And (S1 <> "..") Then
S2 = Drive + S1
i1 = GetAttr(S2)
If i1 > 16 Then i1 = i1 - 32
If i1 And vbDirectory = vbDirectory Then
cntDir = List1.ListCount
If cntDir Mod 10 = 0 Then
DoEvents
End If
List1.AddItem S2 + "\"
End If
End If
S1 = Dir
Wend
DoEvents
i1 = 0
Do
S1 = List1.List(i1)
If S1 = "" Then
S1 = List1.List(i1 - 1)
End If
ChDir (S1)
S2 = CurDir
OK = GetSubDirs(S1)
i1 = i1 + 1
Loop Until i1 > List1.ListCount
End Sub
Function GetSubDirs(ByVal Dir1 As String) As Boolean
Dim DirStr As Variant
Dim cntDir As Integer
Dim i1, i2 As Integer
Dim S1, S2 As String
Dim OK As Boolean
S1 = Dir(Dir1, vbDirectory)
While S1 > ""
If (S1 <> ".") And (S1 <> "..") And (InStr(S1, "?") = 0) Then
S1 = Dir1 + S1
i1 = GetAttr(S1)
If i1 > 32 Then i1 = i1 - 32
i1 = i1 And 16
If i1 = vbDirectory Then
S1 = S1 + "\"
cntDir = List1.ListCount
If cntDir Mod 10 = 0 Then
DoEvents
End If
List1.AddItem S1
End If
End If
S1 = Dir
Wend
End Function
Private Sub Command1_Click()
If Right$(Text1.Text, 1) <> "\" Then Text1.Text = Text1.Text & "\"
GetDirTree (Text1.Text)
|
***************
Mon Home FTP ***************
-------------------------------
Réponse au message :
-------------------------------
> qqun peut t-il me donner le code pour afficher dans une liste bos tous les dossiers d'un repertoire
>
> GtommarC