vba - 循环和重命名文件和文件夹

时间:2016-10-13 15:57:41

标签: excel vba excel-vba

我尝试重命名文件夹,主文件夹中有多个子文件夹和文件 重命名基于许多值,并且需要是动态的(我改变电影和字幕名称)

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

这是我到目前为止所得到的:

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范围是这样的事情: (在excel中命名范围)

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

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

1 个答案:

答案 0 :(得分:0)

最好的方法是创建一个返回新名称的函数。这也将使代码更易于阅读,修改和调试。

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