Dim InitialFolder
Dim OldDrive As String
Dim TotalDir 'переменная для обозначение общего количества папок
 
Private Sub Command1_Click()
ChDrive Drive1.Drive
ChDir Dir1.Path
InitialFolder = CurDir
Text2.Text = ""
ScanFolders
End Sub
 
Sub ScanFolders()
Dim SubFolders As Integer
'///начало обращения к внешней процедуре
'в данный блок вы можете вставить любую процедуру обработки текущей папки
'MsgBox CurrentFolder(Dir1.Path) 'просмотр текущей папки
'снимите маркер, если хотите получить общее количество папок, включая начальную
'TotalDir = TotalDir + 1
 
'\\\конец обращения к внешней процедуре
'В текст1. вводим то что ИЩЕМ.
m = CurrentFolder(Dir1.Path)
If m = (Text1.Text) Then
Text2.Text = Dir1.Path + Chr$(13) + Chr$(10) + Text2.Text
End If
 
 
SubFolders = Dir1.ListCount 'сколько папок в текущей папке
If SubFolders > 0 Then
For i = 0 To SubFolders - 1
ChDir Dir1.List(i)
Dir1.Path = Dir1.List(i)
File1.Path = Dir1.List(i)
Form1.Refresh
ScanFolders
Next
End If
File1.Path = Dir1.Path
MoveUp
End Sub
 
Sub MoveUp()
If Dir1.List(-1) <> InitialFolder Then
ChDir Dir1.List(-2)
Dir1.Path = Dir1.List(-2)
End If
End Sub
 
Private Sub Dir1_Change()
ChDir Dir1.Path
File1.Path = Dir1.Path
End Sub
 
Private Sub Dir1_Click()
With Dir1
.Path = .List(.ListIndex)
End With
End Sub
Private Sub Drive1_Change()
On Error GoTo ErrHan
ChDrive Dir1.Path
Dir1.Path = Drive1.Drive
Dir1.Refresh
'присвоение этой переменной значение Drive1.Drive для исключения ошибки
OldDrive = Drive1.Drive
Exit Sub
ErrHan:
Drive1.Drive = OldDrive
End Sub
 
Private Sub Form_Load()
ChDrive App.Path
ChDir App.Path
End Sub
 
Private Function CurrentFolder(sFolderPath)
Dim str1() As String
str1 = Split(sFolderPath, "\")
CurrentFolder = str1(UBound(str1))
End Function