RECHERCHER FICHIERS

Option Strict Off
Option Explicit On
Imports System.IO
Imports VB = Microsoft.VisualBasic

Friend Class Form1
    Inherits System.Windows.Forms.Form

    'Fonction API pour ouvrir l'aide 
    Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Integer, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Integer) As Integer
    Dim Runnin As Boolean
    Dim filestring As String
    Dim intPercentage As Short
    Dim fichier As String
    Public pos1 As Integer
    Public file As FileInfo
    Public writer As StreamWriter

    Private Sub Form1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles MyBase.Paint
        'Pour afficher l'icône des extensions
        Try
            e.Graphics.DrawIcon(c2i.IO.FileInfo.getSmallIcon(ComboBoxfile.Text), 10, 10)
            e.Graphics.DrawIcon(c2i.IO.FileInfo.getLargeIcon(ComboBoxfile.Text), 32, 10)
        Catch
        End Try
    End Sub
#Region " Recherche Répertoire"
    Public Sub findfilesdir(ByRef DirPath As String, ByRef FileSpec As String)
        On Error Resume Next
        DirPath = Trim(DirPath)
        If VB.Right(DirPath, 1) <> "\" Then
            DirPath = DirPath & "\"
        End If
        filestring = Dir(DirPath & FileSpec, FileAttribute.Archive Or FileAttribute.Hidden Or FileAttribute.System Or FileAttribute.Directory)
        Do
            System.Windows.Forms.Application.DoEvents()
            If filestring = "" Then
                Exit Do
            Else
                If (GetAttr(DirPath & filestring) And FileAttribute.Directory) = FileAttribute.Directory Then
                    If VB.Left(filestring, 1) <> "." And VB.Left(filestring, 2) <> ".." Then
                        lstDirs.Items.Add(DirPath & filestring & "\")
                    End If
                Else
                    If DirPath & filestring Like ComboBoxfile.Text Then
                        lstFiles.Items.Add(DirPath & filestring)
                    End If
                End If
            End If
            filestring = Dir()
        Loop Until Runnin = False
    End Sub

    Private Sub btnfind_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles btnfind.Click
        On Error Resume Next
        Timer1.Enabled = True
        'On nettoie tout
        Me.lstFiles.Items.Clear()
        lbfile.Text = "Fichiers"
        lbtime.Text = "1"
        lbinfo.Text = ""
        lblPercent.Text = ""
        RichTextBox1.Text = ""
        txtFile.Text = ""
        lstDirs.Items.Clear()
        lstFiles.Items.Clear()
        lstDirs.Items.Add(ComboBoxrep.Text)
        ProgressBar1.Value = ProgressBar1.Minimum
        Runnin = True
        intPercentage = 0
        Do
            lbfile.Text = "Recherche de " & VB6.GetItemString(lstDirs, 0) & " " & ComboBoxfile.Text
            findfilesdir(VB6.GetItemString(lstDirs, 0), "*.*")
            lstDirs.Items.RemoveAt(0)
        Loop Until lstDirs.Items.Count = 0 Or Runnin = False
        'On appelle la Sub 'Save_findfiles()'pour l'enregistrement du fichier
        Save_findfiles()
        'On appelle la Sub ' Open_findfiles()'pour l'ouverture du fichier
        Open_findfiles()
        'On appelle la Sub '  Find_findfiles()'pour la recherche du fichier
        Find_findfiles()
        'Fin de la recherche
        btncherche.Enabled = True
        RichTextBox1.ScrollToCaret()
        lbfile.Text = lstFiles.Items.Count & " Fichiers Trouvé(s)"
        Timer1.Enabled = False
        ProgressBar1.Value = ProgressBar1.Maximum
        lblPercent.Text = "100%"
        lbinfo.Text = "Recherche terminée, effectuée en " & CStr(CDbl(lbtime.Text) + 1) & " secondes."
    End Sub
#End Region
#Region " Boutons"
    Private Sub btncancel_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles btncancel.Click
        End
    End Sub

    Private Sub Form1_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
        Runnin = True
        'Les boutons sont inactifs à l'ouverture
        btnfind.Enabled = False
        btncherche.Enabled = False
        btntext.Enabled = False
        btnNext.Enabled = False
        btncherche.Enabled = False
    End Sub
    'On ouvre dans la ListBox double click
    Private Sub lstFiles_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) Handles lstFiles.DoubleClick
        Dim i As Short
        For i = lstFiles.Items.Count - 1 To 0 Step -1
            If lstFiles.GetSelected(i) Then
            End If
        Next i
        Try
            OpenWith(lstFiles.SelectedItem) ' on ouvre avec le menu 'Ouvrir avec'
        Catch ex As Exception
        End Try
    End Sub
    'On ouvre dans la RichTextBox
    Private Sub btntext_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btntext.Click
        Try
            OpenWith(txtFile.Text) ' on ouvre avec le menu 'Ouvrir avec'
        Catch ex As Exception
        End Try
        Me.txtFile.Text = ""
    End Sub
   Private Sub btnclear_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnclear.Click
        'On nettoie tout
        Me.lstFiles.Items.Clear()
        lbfile.Text = "Fichiers"
        lbtime.Text = "00"
        lbinfo.Text = ""
        lblPercent.Text = ""
        RichTextBox1.Text = ""
        txtFile.Text = ""
        ProgressBar1.Value = ProgressBar1.Minimum
    End Sub
    Private Sub ComboBoxfile_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ComboBoxfile.SelectedIndexChanged
        'On affiche le bouton
        btnfind.Enabled = True
        Me.Invalidate() 'On affiche l'icône
    End Sub
    Private Sub ComboBoxrep_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ComboBoxrep.SelectedIndexChanged
        'On affiche le bouton
        btnfind.Enabled = True
    End Sub
   Private Sub txtcherch_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles txtcherch.TextChanged
        'Si pas de texte  = inactif.
        If txtcherch.Text = "" Then
            btnfind.Enabled = False
            'Si présence de texte  = actif.
        Else
            btnfind.Enabled = True
        End If
    End Sub
    Private Sub txtFile_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles txtFile.TextChanged
        'Si pas de texte  = inactif.
        If txtFile.Text = "" Then
            btntext.Enabled = False
            'Si présence de texte = actif.
        Else
            btntext.Enabled = True
        End If
    End Sub
    Private Sub RichTextBox1_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RichTextBox1.TextChanged
        'Si pas de texte  = inactif.
        If RichTextBox1.Text = "" Then
            btncherche.Enabled = False
            btnNext.Enabled = False
            'Si présence de texte = actif.
        Else
            btncherche.Enabled = True
            btnNext.Enabled = True
        End If
    End Sub
#End Region
#Region " Open et Save"
    'On ouvre le fichier 'findfiles'dans la RichTextBox 
    Sub Open_findfiles()
     
        ' on récupère le nom du fichier
        Dim nomFichier As String = (Application.StartupPath & "\findfiles.txt")
        Dim fichier As IO.StreamReader = Nothing
        Try
            ' on ouvre le fichier en lecture
            fichier = New IO.StreamReader(nomFichier)
            ' on lit tout le fichier et on le met dans le RichTextBox
            RichTextBox1.Text = fichier.ReadToEnd()
        Catch ex As Exception
            ' problème
            MessageBox.Show("Problème à la lecture du fichier (" + ex.Message + ")", "Erreur", MessageBoxButtons.OK, MessageBoxIcon.Error)
            Return
        Finally
            ' on ferme le fichier
            Try
                fichier.Close()
            Catch
            End Try
        End Try

    End Sub

    'On enregistre automatiquement la ListBox dans le fichier 'findfiles'
    Sub Save_findfiles()
        file = New FileInfo(Application.StartupPath & "\findfiles.txt")
        file.Attributes = FileAttributes.Normal
        writer = New StreamWriter(Application.StartupPath & "\findfiles.txt")
        If lstFiles.Items.Count <> 0 Then
            For pos1 = 0 To lstFiles.Items.Count - 1
                writer.WriteLine(lstFiles.Items(pos1))
            Next
        End If
        writer.WriteLine(lstFiles.Text)
        writer.Close()
        file.Attributes = FileAttributes.Normal
    End Sub
#End Region
#Region " Recherche mot"
    Function SetSearchMode() As RichTextBoxFinds
        'On vérifie la casse
        Dim mode As RichTextBoxFinds
        If chkCase.Checked = True Then
            mode = RichTextBoxFinds.MatchCase
        Else
            mode = RichTextBoxFinds.None
        End If
        SetSearchMode = mode
    End Function
    'On recherche un nouveau fichier
    Private Sub btncherche_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btncherche.Click
        'On appelle la Sub '  Find_findfiles()'pour la recherche
        Find_findfiles()
        btntext.Enabled = False
    End Sub

    Private Sub btnNext_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnNext.Click
        'Recherche complète
        Dim selStart As Integer
        Dim srchMode As CompareMethod
        srchMode = SetSearchMode()
        selStart = InStr(RichTextBox1.SelectionStart + 2, RichTextBox1.Text, txtcherch.Text, srchMode)
        If selStart = 0 Then
            MsgBox("Fin de la recherche")
            Exit Sub
        End If
        RichTextBox1.Select(selStart - 1, txtcherch.Text.Length)
        RichTextBox1.ScrollToCaret()
        RichTextBox1.Focus()

    End Sub
    'Recherche du fichier
    Sub Find_findfiles()
        txtFile.Text = ""
        'Recherche de mot
        Dim wordAt As Integer
        Dim srchMode As RichTextBoxFinds
        srchMode = SetSearchMode()
        wordAt = RichTextBox1.Find(txtcherch.Text, 0, srchMode)
        If wordAt = -1 Then
            MsgBox("Ne peut pas trouver le mot")
            Exit Sub
        End If
        RichTextBox1.Select(wordAt, txtcherch.Text.Length)
        btncherche.Enabled = True
        RichTextBox1.ScrollToCaret()
        RichTextBox1.Focus()
    End Sub
#End Region
#Region " Aide"
    'Ouvre le fichier 'Aide 'dans son programme par défaut 
    Public Function OpenFile(ByRef File As String, Optional ByRef Parametres As String = "") As Object
        ShellExecute(Handle.ToInt32, "Open", File, Parametres, My.Application.Info.DirectoryPath, 1)
        OpenFile = 1
    End Function
    Private Sub btnhelp_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnhelp.Click
        'on cherche le chemin
        fichier = My.Application.Info.DirectoryPath & "\Aide.txt"
        Try
            OpenFile(fichier) 'Ouvre le fichier dans son programme par défaut
        Catch ex As Exception
        End Try
    End Sub
#End Region
#Region " Timer"
    'Timer pour le ProgressBar et le pourcentage
    Private Sub Timer1_Tick_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        lbtime.Text = CStr(CDbl(lbtime.Text) + 1)
        ProgressBar1.Value = ProgressBar1.Value + 1
        If ProgressBar1.Value >= ProgressBar1.Maximum Then
            Timer1.Enabled = False
        End If
        intPercentage = intPercentage + 1
        lblPercent.Text = intPercentage & "%"
    End Sub
#End Region
    Private Sub CopierToolStripMenuItem1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CopierToolStripMenuItem1.Click
        'Garantissez que le texte est choisi dans la boîte de texte. 
        If RichTextBox1.SelectionLength > 0 Then
            'Copiez le texte sélectionné .
            RichTextBox1.Copy()
        End If
    End Sub
#Region " Quitter"
   Private Sub Form1_FormClosed(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
        End
    End Sub
    Private Sub btnquit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnquit.Click
        Dim answer As MsgBoxResult
        answer = MsgBox("Avez-vous terminé?", MsgBoxStyle.YesNo)
        If answer = MsgBoxResult.Yes Then
            MsgBox("à Bientôt")
            End
        End If
    End Sub
#End Region

    
   
End Class

Télécharger le zip

08 mars 2008 11:48:20 :

Pour les fichiers ayant le même nom, j'ai ajouté un bouton:"Continuer la recherche"

10 mars 2008 18:42:06 :

J'ai ajouté le Focus sur le nom du fichier recherché, grâce à "Pim" que je remercie

13 mars 2008 15:32:54 :

La ListBox s'enregistre automatiquement et l'on peut ouvrir les fichiers de la listBox d'un double click.

07 mai 2008 13:54:33 :

Ajout du code en VBA Exel, grace au module de http://frederic.sigonneau.free.fr/ que je remercie. Mise en garde: Si vous sélectionnez un nom de fichier image comportant une centaines de photos, la réponse est en MsgBox, donc attention on ne peut pas arrêter la machine avant la fin du processus. Seul solution: Ctrl + alt + suppr pour ouvrir le gestionaire des tâches et arrêter.

07 mai 2008 14:41:52 :

Orthographe

11 mai 2008 10:35:58 :

VBA Excel: Correction au probléme de fichiers trop nombreux en ajoutant une pause entre les MsgBox de façon à pouvoir terminer le cas échéant sans avoir recours au Gestionnaire des tâches. Choix de couleurs pour la Barre de progression.

14 mai 2008 08:59:43 :

VBA Excel: Ajout d'une recherche rapide avec visualisation sur une feuille Excel de tout les fichiers d'une extension avec leurs nombres et la durée de la recherche.

23 mai 2008 14:37:21 :

VBA Excel: Ajout d'une suppression des données sur la feuille Excel, d'un enregistrement des chemins dans un fichier texte grâce au module de: http://dj.joss.free.fr/ que je remercie.

26 mai 2008 16:42:58 :

VBA Excel: On peut ouvrir en cliquant sur le chemin les fichiers textes:.doc dans Word et rtf,html,xml, xls dans la feuille Excel.

27 mai 2008 10:36:29 :

VBA Excel:On peut ouvrir tout les fichiers dans leur programme par défaut en sélectionnant le chemin sur la feuille Excel directement sans passer par "ouvriravec", je rejoins ainsi mon code en VB2005.

13 juillet 2008 11:07:29 :

Automatisation du passage de la listBox à la RichtextBox en supprimant "Openfiledialog au profit de: (Application.StartupPath & "\findfiles.txt") Ajout d'un gadget sympa: afficher les icônes des extensions que j'ai trouvé sur le site de: http://www.c2i.fr