Поиск файлов в субкаталогах по имени средствами vba

[MevsWall]

Добрый день!

Нужно написать макрос, который бы искал в определенной папке (и ее субпапках, обязательно) все файлы, содержащие в названии какую-то строку.
Нужно, чтобы все заданные файлы открывались поочередно программно, перебрать грубо говоря все файлы в папке и суб-папках с опр. названием.
Дир ищет только в самой папке, игнорируя суб-папки. Нашла только как это сделать средствами VB, а VBA понять не могу.

Заранее благодарю!

[doober]

Function ReadFileNames(ByVal FolderPath As String)
   On Error Resume Next
    Set fso = CreateObject("scripting.filesystemobject")
    Set curfold = fso.GetFolder(FolderPath)
    If Not curfold Is Nothing Then

        For Each fil In curfold.Files
            If fil.Name Like "*ваше имя.xls" Then
          ListBox1.AddItem curfold.Path & "\" &  fil.Name
            End If
        Next
        For Each sfol In curfold.SubFolders
            ReadFileNames sfol.Path
        Next
        Set fil = Nothing: Set curfold = Nothing: Set fso = Nothing:
    End If
    
End Function

[doober]

Возможно пригодится.Добавил листбокс как в коде выше-немного тормозит

[IgorGO]

Дир ищет только в самой папке

dir /s - со всеми подкаталогами

[MevsWall]

Сообщение от doober

Function ReadFileNames(ByVal FolderPath As String)
   On Error Resume Next
    Set fso = CreateObject("scripting.filesystemobject")
    Set curfold = fso.GetFolder(FolderPath)
    If Not curfold Is Nothing Then

        For Each fil In curfold.Files
            If fil.Name Like "*ваше имя.xls" Then
          ListBox1.AddItem curfold.Path & "\" &  fil.Name
            End If
        Next
        For Each sfol In curfold.SubFolders
            ReadFileNames sfol.Path
        Next
        Set fil = Nothing: Set curfold = Nothing: Set fso = Nothing:
    End If
    
End Function

Спасибо за ответы, но не понимаю. что здесь отвечает за поиск в суб-каталогах. Если убрать все If.. then отсюда:

For Each fil In curfold.Files
If fil.Name Like "*ваше имя.xls" Then
ListBox1.AddItem curfold.Path & "\" & fil.Name
End If
Next

то Msgbox-ами он выведет fil.Name файлов папки сгк, в подкаталогах не ищет.

Если про это:

For Each sfol In curfold.SubFolders
ReadFileNames sfol.Path
Next


то он не читает. Что такое sfol? Sad Facts of Life?)

[MevsWall]

Сообщение от IgorGO

dir /s - со всеми подкаталогами

Спасибо, но это точно работает в vba? Можно пример?

[doober]

Все прекрасно работает.
Во вложении пример

On Error Resume Next
Set fso = CreateObject("scripting.filesystemo bject")
Set curfold = fso.GetFolder(FolderPath)
If Not curfold Is Nothing Then

For Each fil In curfold.Files
If fil.Name Like "*ваше имя.xls" Then
ListBox1.AddItem curfold.Path & "\" & fil.Name
End If
Next
For Each sfol In curfold.SubFolders
ReadFileNames sfol.Path
Next
Set fil = Nothing: Set curfold = Nothing: Set fso = Nothing:
End If

End Function

Активируйте Лист1 и увидите все файлы в папках

[IgorGO]

да, пожалуйста:

Sub dirdir()
  Shell Environ$("comspec") & " /c Dir /S >dir.txt", vbHide
  MsgBox "Изучайте dir.txt" & "  в " & CurDir
End Sub

в текущем каталоге будет создан файл dir.txt в нем полное содержимое текущего каталога и всех вложенных; и тех, что вложенные в последние; и т.д. - на всю глубину вложений

[EducatedFool]

Сообщение от MevsWall

Нужно написать макрос, который бы искал в определенной папке (и ее субпапках, обязательно) все файлы, содержащие в названии какую-то строку.

Поиском пользоваться не пробовали?
http://excelvba.ru/code/FilenamesCollection

' считываем в колекцию coll нужные имена файлов
    Set coll = FilenamesCollection(ПутьКПапке, "*маска##*.xl*")

[Djeki]

Сообщение от IgorGO

да, пожалуйста:

Sub dirdir()
  Shell Environ$("comspec") & " /c Dir /S >dir.txt", vbHide
  MsgBox "Изучайте dir.txt" & "  в " & CurDir
End Sub

в текущем каталоге будет создан файл dir.txt в нем полное содержимое текущего каталога и всех вложенных; и тех, что вложенные в последние; и т.д. - на всю глубину вложений

Спасибо Игорю. Очень красивое и быстрое решение.. Единственный недостаток - выводит названия файлов на русском языке некорректно. Например: ‘ЇЁб®Є PDF д*©«®ў.xls . Переключение шрифта с Ру на Англ ничего не даёт.. Как исправить этот глюк?? Спасибо за ответ..