Ошибка при обработке файлов в подкаталоге

[DENGA-RU]

Добрый день всем! Задача программы при обработке файлов в подкаталогах папки найти нужный файл и обработать его (для начала там просто msgbox поставил). Однако программа обработав совершив 1 цикл и обработав один подкаталог показала ошибку "run-time "5"" и вывела сообщение о неправильном вызове процедуре или аргументе. Пытался без процедуры делать такая же ошибка вылетает. Проблему сам так и не смог решить, хотелось бы узнать как можно убрать эту ошибку ?

 Public s As String

 Sub Zem_control()
Dim file As String, r As Variant
Dim WayName As String, i As Variant, proverka_file As Long
Dim MyName As String
Dim name_open_file As String
  WayName = Application.ActiveWorkbook.FullName
  MyName = ActiveWorkbook.Name
   s = ThisWorkbook.Path
   s = Dir(s & "\" & "*.*", vbNormal + vbDirectory)
    
    Do While s <> ""
        s = Dir()     'вот тут образуется ошибка  при выходе из первого цикла
        file = ThisWorkbook.Path & "\" & s
        proverka_file = InStr(1, s, ".", vbTextCompare)
        If proverka_file <> 0 Then GoTo Endloop
        
        Call obrabotka_dir
Endloop:
    Loop
End Sub

Private Sub obrabotka_dir()

Dim und_s As String, und_file As String

  und_s = ThisWorkbook.Path & "\" & s & "\"   'опытным путем установил что ошибка идет отсюда, но тогда почему все работает в первом цикле ?
  und_s = Dir(und_s & "\" & "*.*", vbNormal + vbDirectory)
        Do While und_s <> ""
        und_s = Dir()
        und_file = ThisWorkbook.Path & "\" & und_s
        If Right(und_file, 4) = ".xls" Then MsgBox und_file
    Loop
End Sub

[EducatedFool]

Не изобретайте велосипед, - воспользуйтесь готовой функцией:
http://excelvba.ru/code/FilenamesCollection

[DENGA-RU]

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

Не изобретайте велосипед, - воспользуйтесь готовой функцией:
http://excelvba.ru/code/FilenamesCollection

Спасибо за Ваш ответ, но у Вас очень сложный макрос, а хотелось бы, что-нибудь попроще. У меня, к сожалению, пока не получается найти причину вылета цикла.

[Neyandex]

Я для обработки файлов в папке и вложенных папках написал небольшую рекурсивную функцию:

Dim I, fol

Sub liststart()
I = 1
FileList ("D:\JKH.OPEN.INFO\ftp")
End Sub

Sub FileList(fn)


  Set fs = CreateObject("Scripting.FileSystemObject")
  Set fl = fs.GetFolder(fn)
  Set fic = fl.Files
  Set foc = fl.SubFolders
  For Each f1 In foc
    fol = f1.path
    FileList (fn & "\" & f1.Name)
  Next
  Set w1 = ActiveWorkbook.Sheets("fl")
  For Each f1 In fic
      w1.Cells(I, 1).Value = fol
      w1.Cells(I, 2).Value = f1.Name
      I = I + 1
   Next
End Sub

[DENGA-RU]

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

Я для обработки файлов в папке и вложенных папках написал небольшую рекурсивную функцию:

Спасибо Вам за совет, немного переделал и все теперь работает.

Public s As String

 Sub Zem_control()
WayName = Application.ActiveWorkbook.FullName
  MyName = ActiveWorkbook.Name
  Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder(ThisWorkbook.Path)
For Each Folder In Folder.SubFolders
    s = Folder.Name
   Call obrabotka_dir
   Next Folder
   End Sub

Private Sub obrabotka_dir()

Dim und_s As String, und_file As String

  und_s = ThisWorkbook.Path & "\" & s & "\"  
  und_s = Dir(und_s & "\" & "*.*", vbNormal + vbDirectory)
        Do While und_s <> ""
        und_s = Dir()
        und_file = ThisWorkbook.Path & "\" & und_s
        If Right(und_file, 4) = ".xls" Then MsgBox und_file
    Loop
End Sub