vba - зацикливание и переименование файлов и папок

Question

Я пытаюсь переименовать папку, как много вложенных папок и файлов в основной папке переименование основано на многих значениях и необходимо динамическое (я меняю фильмы & названия субтитров)

моя проблема в том, что когда имя папки отвечает на значения имени, макрос не может найти путь для продолжения цикла (если папка не отвечает на значения, тогда макрос работает нормально)

здесь то, что я до сих пор:

Sub moviestest() 
    Call VideoLibrary("C:\movies") 
End Sub 

Private Sub VideoLibrary(path As String) 
    Dim fso As New Scripting.FileSystemObject 
    Dim fld As folder, f As folder, fl As File 

    Set fso = CreateObject("Scripting.FileSystemObject") 
    Set fld = fso.GetFolder(path) 

    For Each Q In Range("Qname") 
     For Each fl In fld.Files 

      myMovie = fl.Name 
      extension = InStrRev(myMovie, ".") 
      myNewMovie = _ 
       Replace(_ 
        Replace(_ 
         Replace(_ 
          Replace(_ 
           Left(myMovie, extension - 1), _ 
          ".", " "), _ 
         "-", " "), _ 
        "_", " "), _ 
       Q, "") & _ 
       Mid(myMovie, extension) 
      fso.MoveFile myMovie, myNewMovie 
     Next 
    Next 


    For Each f In fld.SubFolders 
      Call VideoLibrary(f.path) 
    Next 
End Sub 

файлы имя ищут что-то вроде этого:

• The.something.2013.1080p.BluRay.x264.YIFY.mkv The.something.2013.1080p.BluRay.x264.YIFY.sub Zero.something. 2016.1080p.BluRay.x264- [YTS.AG] .avi (и многие другие имена)

диапазон QName является somethig так: (именованный диапазон в Excel)

bdrip 
x264 
veto 
heb 
BRRip 
XviD 
AC3 
EVO 
blaa 
1080p 
BluRay 
YIFY 

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

Answer 1

Лучшим подходом является функция, которая вернет новое имя. Это также упростит чтение, изменение и отладку кода.

Sub moviestest() 
    Call VideoLibrary("C:\movies") 
End Sub 

Private Sub VideoLibrary(path As String) 
    Dim fso As New Scripting.FileSystemObject 
    Dim fld As folder, f As folder, fl As File 

    Set fso = CreateObject("Scripting.FileSystemObject") 
    Set fld = fso.GetFolder(path) 

    For Each fl In fld.Files 
     fso.MoveFile fl.path, fl.ParentFolder & "\" & getNewMoiveName(fl.Name) 
    Next 

    For Each f In fld.SubFolders 
     Call VideoLibrary(f.path) 
    Next 
End Sub 

Function getNewMoiveName(myMovie As String) As String 
    Dim Q 
    Dim loc As Long 
    Dim extension As String 
    loc = InStrRev(myMovie, ".") 
    extension = Right(myMovie, Len(myMovie) - loc) 
    myMovie = Left(myMovie, loc - 1) 
    myMovie = Replace(myMovie, ".", " ") 
    myMovie = Replace(myMovie, "-", " ") 

    For Each Q In Range("Qname") 
     myMovie = Replace(myMovie, Q, "") 
    Next 

    getNewMoiveName = myMovie & "." & extension 
End Function