Lister le contenu d'un Répertoire
Publié: 30 Mai 2007 à 12:20- Code : Tout sélectionner
Public Function DirectoryListe(Byval wPath As String,Byval wType As String)As Variant
'Déclaration Variable
Dim lstValue List As String
Dim lstValue2 List As String
Dim Path As String
Dim File As String
Dim PathFile As String
Dim i As Long
On Error Goto ErreurHandle
lstValue(0) = ""
If Trim(wPath) = "" Then
DirectoryListe = lstValue
Erase lstValue
Exit Function
Elseif isValideDirectory(Trim(wPath)) = False Then
DirectoryListe = lstValue
Erase lstValue
Exit Function
End If
If Right(Trim(wPath),1)<>"\" Then
Path = wPAth+"\"
End If
i = 0
Select Case Ucase(Trim(wType))
Case "F","FILE","FICHIER"
File = Dir$(Path+"*.*",6)
While File <> ""
i=i+1
lstValue(i) = File
File = Dir$()
Wend
Case "A","ALL","T","TOUT"
File = Dir$(Path+"*.*",16)
While File <> ""
i=i+1
lstValue(i) = File
File = Dir$()
Wend
Case "D","R","DIRECTORY","DOSSIER","REPERTOIRE"
File = Dir$(Path+"*.*",16)
While File <> ""
i=i+1
lstValue2(i) = File
File = Dir$()
Wend
i=0
Forall Value In lstValue2
If isValideFile(Path+Cstr(Value)) = False Then
If Trim(Cstr(value)) <> "." Then
If Trim(Cstr(Value)) <> ".." Then
i=i+1
lstValue(i) = Value
End If
End If
End If
End Forall
End Select
If i > 0 Then
lstValue(0) = "OK"
End If
DirectoryListe = lstValue
i=0
Erase lstValue
Exit Function
ErreurHandle:
Msgbox "("+Cstr(Getthreadinfo (1))+" Call by "+Cstr(Getthreadinfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
lstValue(0) = ""
DirectoryListe = lstValue
Erase lstValue
Exit Function
End Function
isValideDirectory => http://forum.dominoarea.org/viewtopic.php?t=12132
isValideFile => http://forum.dominoarea.org/viewtopic.php?t=12374