更新时间:2023-12-05 21:01:58
***的方法是做一个功能这将返回新名称。这也将使代码更容易阅读,修改和调试。
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 :
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