Показать полную графическую версию : VBS Скрипт переименования файлов
Есть вот такой скрипт, переименовывает файлы по маске, в указанной папке.
Мне нужно чтобы переименование велось рекурсивно, т.е., файлы в подпапках также меняли название, согласно созданной маске, как это сделать? С примерами если можно.
Dim WshShell, FileManagement, BrowseDialogBox, SelectedFolder, OldString, NewString, FullPath, TheFolder, FileList
Dim File, ThisFile, TheString, AlreadyRenamed, TempName, FlagName, Success, FindFlag, NewName, Dummy
Set WshShell = WScript.CreateObject("WScript.Shell")
Set FileManagement = WScript.CreateObject ("Scripting.FileSystemObject")
Set BrowseDialogBox = WScript.CreateObject("Shell.Application")
Set SelectedFolder = BrowseDialogBox.BrowseForFolder(0, "Выберите папку содержащую файлы.", &H0001)
If InStr(1, TypeName(SelectedFolder), "Folder") = 0 Then
Wscript.Quit
Else
OldString = InputBox("Введите маску имени файла","Rename Files")
If OldString = "" Then Wscript.Quit
NewString = InputBox("Введите конечное имя файла","Rename Files")
If NewString = "" Then Wscript.Quit
End If
FullPath = SelectedFolder.ParentFolder.ParseName(SelectedFolder.Title).Path
Set TheFolder = FileManagement.GetFolder(FullPath)
Set FileList = TheFolder.Files
Success = 0
For Each File in FileList
ThisFile = File.Name
TheString = InStr(ThisFile, OldString)
AlreadyRenamed = InStr(ThisFile, "%")
If (TheString <> 0) AND (AlreadyRenamed = 0) Then
Success = 1
TempName = Replace(ThisFile, OldString, NewString)
FlagName = "%" + TempName
File.Name = FlagName
End If
Next
For Each File in FileList
ThisFile = File.Name
FindFlag = InStr(ThisFile, "%")
If FindFlag <> 0 Then
NewName = Replace(ThisFile, "%", "")
File.Name = NewName
End If
Next
If Success = 1 Then
Dummy = WshShell.Popup ("Операция закончена успешно!",5,"Rename Files",64)
Else
Dummy = WshShell.Popup ("Операция закончилась неудачно",0,"Rename Files",16)
End If
Wscript.Quit
wwtf, заведите себе ReNamer (https://www.den4b.com/products/renamer).
megaloman
25-04-2017, 09:34
Есть вот такой скрипт, переименовывает файлы по маске, в указанной папке. » Поясните, пожалуйста, что Вы подразумеваете под маской и по какому принципу переименовываются файлы. Совершенно не хочется копаться в Вашем коде и догадываться о том, какие исходные данные вводятся вручную. Приведите примеры маски, и как найденные по этой маске файлы должны быть переименованы. Есть ли вероятность того, что имя файла после переименования совпадёт с уже имеющимся? Как поступать в этом случае?AllDir = "D:\CMD\JS_Host" ' --------- Полное имя рабочего каталога (без слэжа \ на конце)
Info = "C:\kuku.info"
Maska= "^.*\.xls"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Finfo = FSO.OpenTextFile(Info, 2, True)
Set RegMaska = New RegExp
RegMaska.Pattern = Maska
RegMaska.IgnoreCase = True
Call AllFiles(AllDir)
Finfo.Close
MsgBox "Скрипт завершился"
' ---------------------------------------------------------------------------
Sub AllFiles(WDir)
Set Folds = FSO.GetFolder(WDir)
Set SubF = Folds.SubFolders
Set Files = Folds.Files
For Each jF In Files
' MsgBox jF ' Имя файла с путём
' MsgBox jF.DateLastModified ' Дата и время последней модификации файла
' MsgBox jF.Size ' Размер файла
If RegMaska.Test(jf) Then
Finfo.WriteLine jF + " " + CStr(jF.DateLastModified) + " " + CStr(jF.Size)
End If
Next
For Each Folder In SubF
Call AllFiles(WDir + "\" + Folder.Name)
Next
End SubПосле работы скрипта создается текстовый файл "C:\kuku.info" со списком файлов с расширением xls в папке "D:\CMD\JS_Host" и её подпапках
Есть вот такой скрипт, переименовывает файлы по маске, в указанной папке. »
Поясните, пожалуйс »
Каталог в подпапками и файлами вида *.jpg. Сначала, я ввожу в модальном окне имена файлов которые нужно переименовать, начинающихся, скажем на xxx111.jpg. Затем, во втором модальном окне ввожу, на что переименовывать файлы, например yyy111.jpg.
Все файлы с уникальными именами, совпадений в пределах одной папки нет. В случае если файлы с одинаковыми именами встретятся в разных подпапках - переименовываются согласно вводным данным.
megaloman
25-04-2017, 23:18
wwtf, как я понял, Вы вводите xxx и yyy, а затем переименовываете файлы, содержащие в названии ххх, например, xxx111.jpg в yyy111.jpg. Или, например, траляляxxx111.jpg в траляляyyy111.jpgExtension=".jpg" 'Расширение файлов.
Set WshShell = CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set BrowseDialogBox = CreateObject("Shell.Application")
Do
Set SelectedFolder = BrowseDialogBox.BrowseForFolder(0, "Выберите папку содержащую файлы.", &H1)
If InStr(1, TypeName(SelectedFolder), "Folder") = 0 Then Exit Do
FullPath = SelectedFolder.ParentFolder.ParseName(SelectedFolder.Title).Path
OldString = InputBox("Введите маску имени файла", "Rename Files")
If OldString = "" Then Exit Do
NewString = InputBox("Введите конечное имя файла", "Rename Files")
If NewString = "" Then Exit Do
OldString = LCase(OldString)
NewString = LCase(NewString)
Set RegMaska = New RegExp
RegMaska.Pattern = "^.*"+OldString+".*\" + Extension
RegMaska.IgnoreCase = True
Call AllFiles(FullPath)
Loop
' ---------------------------------------------------------------------------
Sub AllFiles(WDir)
Set Folds = FSO.GetFolder(WDir)
Set SubF = Folds.SubFolders
Set Files = Folds.Files
For Each jF In Files
If RegMaska.Test(jf) Then
jfOld = jf
jfNew = Replace(LCase(jf.Name), OldString, NewString)
Msg = ""
On Error Resume Next
jf.Name = jfNew
If Err.Number <> 0 Then
Msg = Msg + "При попытке переименовать файл" + vbCrLf + vbCrLf
Msg = Msg + jfOld + vbCrLf + vbCrLf
Msg = Msg + "в файл" + vbCrLf + vbCrLf
Msg = Msg + jfNew + vbCrLf + vbCrLf
Msg = Msg + "ошибка: " + Err.Description
Dummy = WshShell.Popup(Msg, 0, "Rename Files", 16)
Else
Msg = Msg + "Файл" + vbCrLf + vbCrLf
Msg = Msg + jfOld + vbCrLf + vbCrLf
Msg = Msg + "переименован в файл" + vbCrLf + vbCrLf
Msg = Msg + jfNew
Dummy = WshShell.Popup(Msg, 5, "Rename Files", 64)
End If
On Error GoTo 0
' MsgBox Msg
End If
Next
For Each Folder In SubF
Call AllFiles(WDir + "\" + Folder.Name)
Next
End Sub
как я понял, Вы вводите xxx и yyy, а затем переименовываете файлы, »
Да, выбираю файлы, содержащие xxx в имени и меняю на любое другое значение. Ваш вариант рабочий, то что нужно, спасибо!
Только один момент, подтверждение о переименовании каждого файла, как его отключить?
В идеале добавить счетчик, такое-то количество файлов было переименовано.
megaloman
26-04-2017, 14:00
Только один момент, подтверждение о переименовании каждого файла, как его отключить?
В идеале добавить счетчик, такое-то количество файлов было переименовано. »
Extension = ".jpg" 'Расширение файлов.
TimeErr = -1 'Время (сек) на сообщение об ошибке (0-ожидание, <0-отмена)
TimeRen = -1 'Время (сек) на сообщение об переименовании (0-ожидание, <0-отмена)
Set WshShell = CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set BrowseDialogBox = CreateObject("Shell.Application")
Do
CountRen = 0
CountErr = 0
Set SelectedFolder = BrowseDialogBox.BrowseForFolder(0, "Выберите папку содержащую файлы.", &H1)
If InStr(1, TypeName(SelectedFolder), "Folder") = 0 Then Exit Do
FullPath = SelectedFolder.ParentFolder.ParseName(SelectedFolder.Title).Path
OldString = InputBox("Введите маску имени файла", "Rename Files")
If OldString = "" Then Exit Do
NewString = InputBox("Введите конечное имя файла", "Rename Files")
If NewString = "" Then Exit Do
OldString = LCase(OldString)
NewString = LCase(NewString)
Set RegMaska = New RegExp
RegMaska.Pattern = "^.*" + OldString + ".*\" + Extension
RegMaska.IgnoreCase = True
Call AllFiles(FullPath)
MsgBox "Переименовано файлов: " + CStr(CountRen) + vbCrLf + "Не удалось переименовать: " + CStr(CountErr)
Loop
' ---------------------------------------------------------------------------
Sub AllFiles(WDir)
Set Folds = FSO.GetFolder(WDir)
Set SubF = Folds.SubFolders
Set Files = Folds.Files
For Each jf In Files
If RegMaska.Test(jf) Then
jfOld = jf
jfNew = Replace(LCase(jf.Name), OldString, NewString)
Msg = ""
On Error Resume Next
jf.Name = jfNew
If Err.Number <> 0 Then
Msg = Msg + "При попытке переименовать файл" + vbCrLf + vbCrLf
Msg = Msg + jfOld + vbCrLf + vbCrLf
Msg = Msg + "в файл" + vbCrLf + vbCrLf
Msg = Msg + jfNew + vbCrLf + vbCrLf
Msg = Msg + "ошибка: " + Err.Description
If TimeErr >= 0 Then Dummy = WshShell.Popup(Msg, TimeErr, "Rename Files", 16)
CountErr = CountErr + 1
Else
Msg = Msg + "Файл" + vbCrLf + vbCrLf
Msg = Msg + jfOld + vbCrLf + vbCrLf
Msg = Msg + "переименован в файл" + vbCrLf + vbCrLf
Msg = Msg + jfNew
If TimeRen >= 0 Then Dummy = WshShell.Popup(Msg, TimeRen, "Rename Files", 64)
CountRen = CountRen + 1
End If
On Error GoTo 0
' MsgBox Msg
End If
Next
For Each Folder In SubF
Call AllFiles(WDir + "\" + Folder.Name)
Next
End Sub
© OSzone.net 2001-2012
vBulletin v3.6.4, Copyright ©2000-2024, Jelsoft Enterprises Ltd.