LISTE DE FICHIERS SUR UN DISQUE EN VB6

Public Sub FileSearch(xPath, XFile, xFichierSortie, xTypesDeFichiersRecherches As Byte)
    Dim ww As String
    Dim xx, yy, zz, FichierErreurs As Integer
    Dim NbErreurs As Long
    Dim w, wx As String
    Dim Test As Boolean
    Dim Entree1, Entree2 As String
    
    Entree1 = App.Path & "\tmp1.txt"
    Entree2 = App.Path & "\tmp2.txt"
    
    FichierErreurs = FreeFile:  Open App.Path & "\fichiersOuRepertoiresNonLus.txt" For Output As 

FichierErreurs
    
    zz = FreeFile: Open xFichierSortie For Output As zz
    Test = False
    xx = FreeFile
    Open Entree1 For Output As xx
        w = ""
        On Error GoTo TERR
        w = Dir(xPath & "*.*", xTypesDeFichiersRecherches)
        On Error GoTo 0
        While w <> ""
            If w <> ".." And w <> "." Then
                w = xPath & w
                If IsFile(w) Then
                    Print #zz, w
                Else
                    Print #xx, w
                    Test = True
                End If
            End If
            w = Dir
        Wend
    Close xx
    
    While Test
        xx = FreeFile: Open Entree1 For Input As xx
        yy = FreeFile: Open Entree2 For Output As yy
        Test = False
        While Not EOF(xx)
            Line Input #xx, w
            Print #zz, w & "\"
            ww = ""
            On Error GoTo TERR
            ww = Trim(Dir(w & "\*.*", xTypesDeFichiersRecherches))
            On Error GoTo 0
            While ww <> ""
                If ww <> ".." And ww <> "." Then
                    ww = w & "\" & ww
                    If IsFile(ww) Then
                        Print #zz, ww
                        LblInfo = w
                        DoEvents
                    Else
                        Print #yy, ww
                        Test = True
                    End If
                End If
                ww = Trim(Dir)
            Wend
        Wend
        wz = Entree1: Entree1 = Entree2: Entree2 = wz
        Close xx
        Close yy
    Wend
    Close zz
    If ExistFile(Entree1) Then Kill Entree1
    If ExistFile(Entree2) Then Kill Entree2
    Me.SetFocus
    ww = " Liste disponible dans : " & RésultatTxt.Text
    ww = ww & vbCrLf
    ww = ww & vbCrLf & "  Fichiers ou répertoires inaccessibles = " & NbErreurs
    ww = ww & vbCrLf & "  Voir le fichier " & App.Path & "\fichiersOuRepertoiresNonLus.txt"
    ww = ww & vbCrLf
    LblInfo.Caption = ww
    Close #FichierErreurs
    Exit Sub
TERR:
    Print #FichierErreurs, Err.Number, "| " & w & " |"
    NbErreurs = NbErreurs + 1
    Resume Next
End Sub