Extraire la liste des fichiers/dossier d'un repertoire

Tien je viens d'avoir une reponse par ailleur

Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Const FILE_ATTRIBUTE_COMPRESSED = &H800
Private Const MAX_PATH = 260

Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type


Private Declare Function FindFirstFile Lib "kernel32" Alias
"FindFirstFileA" _
(ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As
Long

Private Declare Function FindNextFile Lib "kernel32" Alias
"FindNextFileA" _
(ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As
Long

Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As
Long) As Long



Public Sub GetFiles(Path As String, SubFolder As Boolean)
Screen.MousePointer = 11


Dim WFD As WIN32_FIND_DATA
Dim hFile As Long, fPath As String, fName As String

fPath = AddBackslash(Path)
fName = fPath & "*.*"


hFile = FindFirstFile(fName, WFD)
If (hFile > 0) And ((WFD.dwFileAttributes And
FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY) Then
msgbox StripNulls(WFD.cFileName)
End If

While FindNextFile(hFile, WFD)
'Solange "FindNextFile" ausfuehren, bis keine Datei mehr
gefunden wird, also hFile 0 ist.
If ((WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <>
FILE_ATTRIBUTE_DIRECTORY) Then
Msgbox StripNulls(WFD.cFileName)

End If
Wend

If SubFolder Then


hFile = FindFirstFile(fName, WFD)
If (hFile > 0) And ((WFD.dwFileAttributes And
FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) And _
StripNulls(WFD.cFileName) <> "." And StripNulls(WFD.cFileName)
<> ".." Then

GetFiles fPath & StripNulls(WFD.cFileName), True
End If

While FindNextFile(hFile, WFD)
If ((WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) FILE_ATTRIBUTE_DIRECTORY) And _
StripNulls(WFD.cFileName) <> "." And
StripNulls(WFD.cFileName) <> ".." Then

GetFiles fPath & StripNulls(WFD.cFileName), True
End If
Wend

End If
FindClose hFile


Screen.MousePointer = 0
End Sub


"Jacques93" <jacques@Nospam> a écrit dans le message de news:
e4lt0eTbGHA.4144@TK2MSFTNGP04.phx.gbl...

Bonjour mg,
mg a écrit :
> justement mon probleme consiste a ne pas pouvoir faire cette gymastique.
> je crois qu'il faut utiliser la recursivité mais j'arrive pas a
> l'implementer.
> ca peu etre interessant de faire ca car sur tous les exemples que jai
> trouver aucun e fait ce genre d'oeration.
>

Un petit exemple de récursivité (en local). Il faut une feuille avec une
ListBox et un Bouton. Effectue l'équivalent de DIR /S

Je ne suis pas sûr que faire cela sur un site FTP soit une bonne idée,
certains sites sont énormes (ftp.microsoft.com par exemple).


Option Explicit

Private Sub Command1_Click()
ListDir ("C:RepDeDepart")
End Sub

Private Sub ListDir(sPath As String)
Dim Rep As String
Dim Reps() As String
Dim Count As Integer, i As Integer

List1.AddItem sPath
ListFiles sPath
Rep = Dir(sPath, vbDirectory)
While Len(Rep) > 0
If Rep <> "." And Rep <> ".." Then
If GetAttr(sPath & Rep) = vbDirectory Then
ReDim Preserve Reps(Count + 1)
Count = Count + 1
Reps(Count) = Rep
End If
End If
Rep = Dir()
Wend
For i = 1 To Count
ListDir sPath & Reps(i) & ""
Next i
End Sub

Private Sub ListFiles(sPath As String)
Dim Fic As String

Fic = Dir(sPath & "*.*")
While Len(Fic) > 0
List1.AddItem vbTab & Fic
Fic = Dir()
Wend
End Sub

--
Cordialement,

Jacques.