VBS/WSH/JS - VBS Скрипт переименования файлов

wwtf · Сообщение **wwtf** » 24 апр 2017, 16:21

Есть вот такой скрипт, переименовывает файлы по маске, в указанной папке.

Мне нужно чтобы переименование велось рекурсивно, т.е., файлы в подпапках также меняли название, согласно созданной маске, как это сделать? С примерами если можно.

Код:

Код: Выделить всё

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

Iska · Сообщение **Iska** » 24 апр 2017, 16:21

wwtf, заведите себе

ReNamer

.

Iska · Сообщение **Iska** » 24 апр 2017, 16:32

Цитата wwtf:

Есть вот такой скрипт, переименовывает файлы по маске, в указанной папке.

VBS/WSH/JS - VBS Скрипт переименования файлов

Поясните, пожалуйста, что Вы подразумеваете под маской и по какому принципу переименовываются файлы. Совершенно не хочется копаться в Вашем коде и догадываться о том, какие исходные данные вводятся вручную. Приведите примеры маски, и как найденные по этой маске файлы должны быть переименованы. Есть ли вероятность того, что имя файла после переименования совпадёт с уже имеющимся? Как поступать в этом случае?

Вот пример рекурсии, но чтобы довести этот мой скрипт, найденный у меня в архиве, до Ваших требований, необходимо их иметь во внятном виде

[spoiler]Код:

[/spoiler]

Код: Выделить всё

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" и её подпапках

wwtf · Сообщение **wwtf** » 25 апр 2017, 08:34

Цитата megaloman:

Есть вот такой скрипт, переименовывает файлы по маске, в указанной папке. »

Поясните, пожалуйс

VBS/WSH/JS - VBS Скрипт переименования файлов

Каталог в подпапками и файлами вида *.jpg. Сначала, я ввожу в модальном окне имена файлов которые нужно переименовать, начинающихся, скажем на xxx111.jpg. Затем, во втором модальном окне ввожу, на что переименовывать файлы, например yyy111.jpg.

Все файлы с уникальными именами, совпадений в пределах одной папки нет. В случае если файлы с одинаковыми именами встретятся в разных подпапках - переименовываются согласно вводным данным.

megaloman · Сообщение **megaloman** » 25 апр 2017, 16:21

wwtf, как я понял, Вы вводите xxx и yyy, а затем переименовываете файлы, содержащие в названии ххх, например, xxx111.jpg в yyy111.jpg. Или, например, траляляxxx111.jpg в траляляyyy111.jpg

Вот вариант решения. По максимуму использовал Ваш скрипт

[spoiler]Код:

[/spoiler]

Код: Выделить всё

Extension=".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

wwtf · Сообщение **wwtf** » 25 апр 2017, 22:18

Цитата megaloman:

как я понял, Вы вводите xxx и yyy, а затем переименовываете файлы,

VBS/WSH/JS - VBS Скрипт переименования файлов

Да, выбираю файлы, содержащие xxx в имени и меняю на любое другое значение. Ваш вариант рабочий, то что нужно, спасибо!

Только один момент, подтверждение о переименовании каждого файла, как его отключить?

В идеале добавить счетчик, такое-то количество файлов было переименовано.

megaloman · Сообщение **megaloman** » 26 апр 2017, 11:41

Цитата wwtf:

Только один момент, подтверждение о переименовании каждого файла, как его отключить?

В идеале добавить счетчик, такое-то количество файлов было переименовано.

VBS/WSH/JS - VBS Скрипт переименования файлов

Добавил счётчик и сделал настройку времени вывода сообщений

[spoiler]

Код: Выделить всё

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

[/spoiler]

VBS/WSH/JS - VBS Скрипт переименования файлов

VBS/WSH/JS - VBS Скрипт переименования файлов

Re: VBS/WSH/JS - VBS Скрипт переименования файлов

Re: VBS/WSH/JS - VBS Скрипт переименования файлов

Re: VBS/WSH/JS - VBS Скрипт переименования файлов

Re: VBS/WSH/JS - VBS Скрипт переименования файлов

Re: VBS/WSH/JS - VBS Скрипт переименования файлов

Re: VBS/WSH/JS - VBS Скрипт переименования файлов