Soyez le premier à donner votre avis sur cette source.
Vue 4 663 fois - Téléchargée 425 fois
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
mdr
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.