THE INFORMATIQUE

Cette démo permet de rechercher sur un disque dur un fichier dont ont ne connaît pas le chemin. 

Préliminaires

Sur une forme, Un TextBox (TextBox1) et un label (Label1) 
Collés le code dans le module de la forme. 

Le code

Public Class Form1 
    Dim Trouver As String 
    Dim Cherche As String 

    Sub LireRep(ByVal Chem As String) 
        Dim Rep, sRp, Obj, sRep, sR2 
        Dim sCle As String 
        Dim NbsR As Integer, S As String 
        Chem = Chem & IIf(Microsoft.VisualBasic.Right(Chem, 1) = "\", "", "\") 
        '-------  au cas ou ce serait dans le DD 
        Trouver = Dir(Chem & Cherche) 
        If Trouver <> "" Then Trouver = Chem & Trouver : Exit Sub 
        '-------------------------------------- 
        Obj = CreateObject("Scripting.FileSystemObject") 
        Rep = Obj.Getfolder(Chem) 
        If Microsoft.VisualBasic.Left(Rep.Name, 1) = "$" Then GoTo Passe2 
        sRep = Rep.subfolders 
        For Each sRp In sRep 
            S = UCase(sRp.Name) 
            'sortir de la boucle précédante si le fichier est trouver 
            If Trouver <> "" Then Exit For 
            '------------ Elimine les répertoires système 
            If Microsoft.VisualBasic.Left(S, 1) = "$" Or S = "WINDOWS" Or sRp.Attributes = 19 _ 
                Or Microsoft.VisualBasic.Left(S, 6) = "SYSTEM" Or Microsoft.VisualBasic.Left(S, 7) = "PROGRAM" Or Microsoft.VisualBasic.Left(S, 4) = "USER" _ 
                Or Microsoft.VisualBasic.Left(S, 6) = "DRIVER" Or Microsoft.VisualBasic.Left(S, 5) = "TOOLS" Then GoTo Passe 
            On Error Resume Next 
            sR2 = sRp.subfolders 
            NbsR = sR2.Count 
            If Err.Number <> 0 Then GoTo Passe 
            sCle = sRp.Path & IIf(Microsoft.VisualBasic.Right(sRp.Path, 1) <> "\", "\", "") 
            Trouver = Dir(sCle & Cherche) 
            If Trouver <> "" Then Trouver = sCle & Trouver : Exit Sub 
            On Error GoTo 0 

            If NbsR > 0 Then 
                'lecture récursive des sous-réperto!res 
                LireRep(sCle) 
            End If 
Passe: 
        Next 
Passe2: 
        'libère la mémoire 
        Obj = Nothing 
        Rep = Nothing 
        sRep = Nothing 
        sR2 = Nothing 
    End Sub 

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click 
        Trouver = "" 
        Cherche = Trim(TextBox1.Text) 
        If Cherche = "" Then Exit Sub 
        LireRep("c:\") 
        If Trouver <> "" Then 
            Label1.Text = Trouver 
        Else 
            Label1.Text = "Fichier non trouvé" 
        End If 
    End Sub 
End Class

Téléchargement

Télécharger la solution