vba - 循环并重命名文件和文件夹 [英] vba - looping and renaming files and folders

问题描述

我正在尝试重命名一个文件夹，在主文件夹
中有许多子文件夹和文件，重命名是基于许多值，它需要是动态的（我正在更改电影和字幕名称） / p>

我的问题是 - 当文件夹名称回答名称更改的值时，宏无法找到继续循环的路径（如果文件夹不回答值那么宏工作正常）

这里我到目前为止：

  Sub moviestest（）
调用VideoLibrary（C：\movies）
 End Sub 
 
私有Sub VideoLibrary（路径As String）
 Dim fso As New Scripting.FileSystemObject 
 Dim fld As folder，f As folder，fl As File 
 
设置fso = CreateObject（Scripting.FileSystemObject）
设置fld = fso.GetFolder（路径）
 
对于每个Q范围（Qname）
对于每个fl在fld.Files 
 
 myMovie = fl.Name 
 extension = InStrRev（myMovie，。）
 myNewMovie = _ 
替换（_ 
替换（_ 
替换（_ 
替换（_ 
左（myMovie，extension-1））_ 
 。，），_ 
 - ，），_ 
_，），_ 
 Q，）& _ 
中（myMovie，扩展名）
 fso.MoveFile myMovie，myNewMovie 
下一个
下一个
 
 
对于每个f在fld.SubFolders 
调用VideoLibrary（f.path）
下一个
 End Sub 
  

文件名称如下所示：

• The.something.2013.1080p.BluRay.x264.YIFY.mkv
  .something.2013.1080p.BluRay.x264.YIFY.sub
  Zero.something.2016.1080p.BluRay.x264- [YTS.AG] .avi（还有更多
  名称）

Qname范围是这样的：
（excel中的命名范围）

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

这是我第一次问在这个论坛。我希望我尽可能清楚我的问题
任何帮助将不胜感激

解决方案

最好的方法是做一个功能这将返回新名称。这也将使代码更容易阅读，修改和调试。

  Sub moviestest（）
调用VideoLibrary（ C：\movies）
 End Sub 
 
私有Sub VideoLibrary（路径As String）
 Dim fso As New Scripting.FileSystemObject 
 Dim fld As folder，f作为文件夹，fl As File 
 
设置fso = CreateObject（Scripting.FileSystemObject）
设置fld = fso.GetFolder（路径）
 
对于每个fl fld.Files 
 fso.MoveFile fl.path，fl.ParentFolder& \& getNewMoiveName（fl.Name）
下一个
 
对于每个f在fld.SubFolders 
调用VideoLibrary（f.path）
下一个
 End Sub 
 
函数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， - ，）
 
对于每个Q范围（Qname）
 myMovie =替换（myMovie，Q，）
下一个
 
 getNewMoiveName = myMovie&  &安培;扩展
结束功能
  

I'm trying to rename a folder how has many subfolders and files inside a main folder the renaming is based to many values and its need to be dynamic (i'm changing films & subtitles names)

my problem is - when the folder name answer the values for the name change the macro can't find a path to continue the loop (if the folder do not answer the values then the macro works fine)

here what I get so far:

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

files name are looking something like this :

• 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 (and many more names)

Qname range is somethig like this : (named range in excel)

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

this is my first time asking in this forum. I hope I made my question clear as possible any help will be appreciated

解决方案

The best approach is make a function that will return the new name. This will also make the code easier to read, modify and debug.

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

这篇关于vba - 循环并重命名文件和文件夹的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！