Ce code permet de lister tous les fichiers d'un ou plusieurs disques. Il peut etre utile pour creer par exemple une recherche de fichiers.
Source / Exemple :
2 Form
# Form FrmFolder :
Option Explicit
Public Cancel As Boolean
Public Folder As String
'---- OK
Private Sub cmdOK_Click()
Cancel = False
Folder = fld
Me.Hide
End Sub
'---- Annulation
Private Sub cmdCancel_Click()
Cancel = True
Me.Hide
End Sub
'---- Changement de drive
Private Sub drv_Change()
fld = drv
End Sub
'---- Initialisation
Private Sub Form_Load()
On Error Resume Next
Cancel = True
drv = Folder
fld = Folder
End Sub
# FrmMain
Option Explicit
' Le système de fichiers
Dim fso As New FileSystemObject
' Colonne d'affichage courante
Dim nCol As Integer
' Indicateur d'interruption
Dim fStop As Boolean
' Dossier courant
Dim CurrentFolder As String
'---- Choix d'un dossier
Private Sub cmdFolder_Click()
' Charge la boîte
Load frmFolder
' Initialise
frmFolder.Folder = CurrentFolder
' La montre
frmFolder.Show vbModal
' Traite le résulata
If Not frmFolder.Cancel Then
' Mémorise
CurrentFolder = frmFolder.Folder
' Lance la recherche
fStop = False
cmdStop.Enabled = True
lstFichiers.Clear
ExploreFolder fso.GetFolder(CurrentFolder)
cmdStop.Enabled = False
End If
' Décharge
Unload frmFolder
End Sub
Private Sub cmdAll_Click()
fStop = False
cmdStop.Enabled = True
' Boucle sur les disques
Dim d As Drive
For Each d In fso.Drives
If fStop Then Exit For
If d.IsReady Then
lstFichiers.Clear
' Ajoute le nom du disque
lstFichiers.AddItem d.Path
nCol = 2
' Explore les dossiers
ExploreFolder d.RootFolder
End If
Next
cmdStop.Enabled = False
End Sub
'---- Explore un folder
Private Sub ExploreFolder(fld As Folder)
' Interruption
If fStop Then Exit Sub
' Ajoute le nom du folder
lstFichiers.AddItem String(nCol, ".") & fld.Name
nCol = nCol + 1
' Affiche les fichiers
Dim f As File
For Each f In fld.Files
With lstFichiers
.AddItem String(nCol, ".") & f.Name
.ListIndex = .NewIndex
End With
' Pour détecter la touche d'arrêt
DoEvents
Next
' Traite les sous-dossiers
Dim fld1 As Folder
For Each fld1 In fld.SubFolders
ExploreFolder fld1
Next
' Ajuste colonne
nCol = nCol - 1
End Sub
'---- Arrêt
Private Sub cmdStop_Click()
fStop = True
End Sub
Conclusion :
Ce code n'est pas de moi :-) mais vous pouvez toujours m'envoyer des remarques ou des questions.
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.