Donc le code ci-dessus me permet d'afficher tous les dossiers et sous dossiers d'un disque ou d'un dossier, a condition qu'il ne soient pas vides car dans ce cas ils sont ignorés.
Try Directory.GetFiles(sourceRep, "*.*", SearchOption.AllDirectories) Dim repficTrouv = Directory.GetFiles(sourceRep, "*.*", SearchOption.AllDirectories) For Each ligneF In repficTrouv ListBox1.Items.Add(ligneF) Next Catch ex As Exception TextBox1.Text = ex.Message End Try
Imports System.IO Public Class Form1 Dim DirSubDirArray As New ArrayList Dim sourceDir As String = "D:\Gestion" Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click Dim DirArray As New ArrayList GetAllDir(sourceDir, DirArray) DirArray.Clear() For Each item In DirSubDirArray Try If Directory.GetFiles(item, "*.*", SearchOption.TopDirectoryOnly).Length > 0 Then getFichiers(item) Else ListBox2.Items.Add(item & "\") End If Catch er As Exception 'gérer les refus pour les fichiers d'accès protégés Label1.Text = er.Message End Try Next DirSubDirArray.Clear() End Sub 'Obtenir tous les dossiers et les sous dossier Sub GetAllDir(ByVal StartPath As String, ByRef directoryList As ArrayList) Try Dim subDirs() As String = Directory.GetDirectories(StartPath) For Each Dir As String In subDirs GetAllDir(Dir, directoryList) 'appel récurcif pour obtenir tous les sous répertoires DirSubDirArray.Add(Dir) 'mémorise tous les sous répertoires Next Catch er As Exception 'gérer les refus pour les fichiers d'accès protégés Label1.Text = er.Message End Try End Sub 'Obtenir tous les fichiers de chaque sous dossier Sub getFichiers(dossier As String) Dim fichiers = Directory.GetFiles(dossier, "*.*", SearchOption.TopDirectoryOnly) For Each fic In fichiers ListBox2.Items.Add(fic) Next End Sub End Class
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionPrivate Sub Form1_Load(ByVal sender As Object, ByVal e As EventArgs) backgroundWorker1.DoWork += AddressOf BackgroundWorker1_DoWork 'thread principal du backgroundworker backgroundWorker1.WorkerReportsProgress = True 'autorise le thread principale à envoyer une progression backgroundWorker1.ProgressChanged += AddressOf BackgroundWorker1_ProgressChanged 'abonnement à l'évènement de progression backgroundWorker1.RunWorkerCompleted += AddressOf BackgroundWorker1_RunWorkerCompleted ' abondment à l'évènement signalant la fin du trhead principal End Sub ''' <summary> ''' Méthode qui est lancée quand on active le travail du backgroundworker, elle en constitue le thread principal ''' </summary> ''' <paramname="sender"></param> ''' <paramname="e"></param> Private Sub BackgroundWorker1_DoWork(ByVal sender As Object, ByVal e As DoWorkEventArgs) Dim resultat As List(Of String) = New List(Of String)() Dim erreurs As List(Of String) = New List(Of String)() Explorer(e.Argument.ToString(), resultat, erreurs) e.Result = New Object(){resultat, erreurs} End Sub ''' <summary> ''' Méthode récursive d'exploration de fichiers / dossiers ''' </summary> ''' <paramname="CheminRacine"></param> ''' <paramname="Resultat"></param> ''' <paramname="Erreurs"></param> Private Sub Explorer(ByVal CheminRacine As String, ByVal Resultat As List(Of String), ByVal Erreurs As List(Of String)) backgroundWorker1.ReportProgress(0) 'on envoie n'importe quoi comme progression car on ne connait pas le nombre de regression, mais on annime le curseur à chaque étape Try Resultat.AddRange(Directory.GetFiles(CheminRacine)) For Each d In Directory.GetDirectories(CheminRacine) Resultat.Add(d & "\") Explorer(d, Resultat, Erreurs) Next Catch e As Exception Erreurs.Add(e.Message) End Try End Sub ''' <summary> ''' Méthode permettant d'afficher une progression, en général une barre qui avance ''' </summary> ''' <paramname="sender"></param> ''' <paramname="e"></param> Private Sub BackgroundWorker1_ProgressChanged(ByVal sender As Object, ByVal e As ProgressChangedEventArgs) 'force le curseur à afficher le symbole d'attente (une "roue" qui tourne sous W10) If Cursor.Current IsNot Cursors.WaitCursor Then Cursor.Current = Cursors.WaitCursor End Sub ''' <summary> ''' Méthode qui est lancée quand le travail du backgroundwork est fini ''' </summary> ''' <paramname="sender"></param> ''' <paramname="e"></param> Private Sub BackgroundWorker1_RunWorkerCompleted(ByVal sender As Object, ByVal e As RunWorkerCompletedEventArgs) Dim res = CType(e.Result, Object()) listBox1.DataSource = CType(res(0), List(Of String)).Take(100).ToList() 'dans mon test sur c:\windows, j'ai 281 419 c'est trop long à afficher donc je ne mets que les 100 premiers listBox2.DataSource = CType(res(1), List(Of String)) ' dans mon test j'ai 30 erreurs d'accès. Cursor.Current = Cursors.[Default] End Sub Private Sub button1_Click(ByVal sender As Object, ByVal e As EventArgs) If backgroundWorker1.IsBusy Then MessageBox.Show("Il y a déja une recherche en cours") Return End If backgroundWorker1.RunWorkerAsync("C:\Windows") End Sub