Private Sub Command1_Click()
DozvilPokazuFile = False
Dim PotMemory As String
Dim Ustanovka As String
 Dim PoperednShlah As String
 Dim TmpPath As String
 Dim PoperedniyPath( 50 ) As String ' Кількість попередніх шляхів
 Dim Glibina As Integer ' Рівень
 Dim n As String
Ustanovka = Dir1.Path
List1.Clear

Call PereglFile

Dali2:
 'DoEvents
 If Dir1.ListIndex < Dir1.ListCount -  1  Then
  Dir1.ListIndex = Dir1.ListIndex +  1 
 Else
  n = Dir1.Path
  Glibina = Glibina -  1 
  If Glibina <  0  Then Exit Sub
  Dir1.Path = PoperedniyPath(Glibina)
  
  n = Right(n, Len(n) - Len(Dir1.Path))
   If Dir1.ListCount >  0  Then
    If Len(Dir1.Path) <  4  Then
      n = "\" + n
    End If
     For f =  1  To Dir1.ListCount
      If Mid(Dir1.List(f -  1 ), InStrRev(Dir1.List(f -  1 ), "\")) = n Then Dir1.ListIndex = f -  1 : GoTo Dali3
     Next
    'DoEvents
    Dir1.ListIndex = Dir1.ListCount -  1 
Dali3:
   End If
  GoTo Dali2
 End If
Dali1:
  PotMemory = Dir1.Path
  PoperedniyPath(Glibina) = Dir1.Path
  Glibina = Glibina +  1 
  Dir1.Path = Dir1.List(Dir1.ListIndex)
   Call PereglFile
  DoEvents
  GoTo Dali2
End Sub


Private Sub PereglFile()
  Dim TmpPF As Long
  Dim TmpNF As String
  Static ZagKilkist As Long
  If File1.ListCount >  0  Then
    For TmpPF =  1  To File1.ListCount
     TmpNF = File1.Path + "\" + File1.List(TmpPF -  1 )
      File1.ListIndex = TmpPF -  1 
      ZagKilkist = ZagKilkist +  1 
      Form1.Caption = Str(ZagKilkist)

      List1.AddItem " " + TmpNF
      'СДЕСЬ ИЩИ САМ ЧТО НУЖНО!

      DoEvents
    Next
  End If
End Sub

Private Sub Dir1_Change()
 ' File1.Path = Dir1.Path
End Sub

Private Sub Drive1_Change()
  Dir1.Path = Drive1.Drive
End Sub

Private Sub Command1_Click()
Dim Mem( 50 ) As String
Dim Riven As Integer
Dim StatusE As Boolean
Dim objFSO As New FileSystemObject
Dim Path As String
Dim NextPath As String
Dim objFolder As Folder
Dim OstFolder As Boolean
 Path = "D:\Музика\"  ' Указывайте сдесь свой путь
che:
    Set objFolder = objFSO.GetFolder(Path)
    StatusE = False
    For Each objFolder In objFolder.SubFolders
        OstFolder = False
        If Mem(Riven) = "" Then
          StatusE = True
          NextPath = objFolder.Name
          Exit For
        End If
        If StatusE = True Then
          NextPath = objFolder.Name
          Exit For
        End If
        If Mem(Riven) = objFolder.Name Then
          StatusE = True
          OstFolder = True
        End If
    Next objFolder
    
    
    
    If StatusE = True And OstFolder = False Then
      Mem(Riven) = NextPath
      Riven = Riven +  1 
      Path = Path + NextPath + "\"
        List1.AddItem Path
        List1.ListIndex = List1.ListCount -  1 
        DoEvents
        StatusE = False
    Else
      If Riven =  0  Then Exit Sub
      Mem(Riven) = ""
      Riven = Riven -  1 
      Path = Left(Path, Len(Path) -  1 )
      NextPath = Mid(Path, InStrRev(Path, "\") +  1 )
      Path = Left(Path, InStrRev(Path, "\"))
      StatusE = False
    End If
GoTo che
End Sub

Private Sub Dir1_Change()
  File1.Path = Dir1.Path ' было отключено
End Sub