Имя пользователя:
Пароль:  
Помощь | Регистрация | Забыли пароль?  | Правила  

Компьютерный форум OSzone.net » Программирование, базы данных и автоматизация действий » Скриптовые языки администрирования Windows » VBS/WSH/JS - VBS Скрипт переименования файлов

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

Новый участник


Сообщения: 3
Благодарности: 0

Профиль | Отправить PM | Цитировать


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

Код: Выделить весь код
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

Отправлено: 17:21, 24-04-2017

 

Ветеран


Сообщения: 27449
Благодарности: 8086

Профиль | Отправить PM | Цитировать


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

Отправлено: 17:32, 24-04-2017 | #2



Для отключения данного рекламного блока вам необходимо зарегистрироваться или войти с учетной записью социальной сети.

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


Ветеран


Contributor


Сообщения: 2703
Благодарности: 1683

Профиль | Отправить PM | Цитировать


Цитата wwtf:
Есть вот такой скрипт, переименовывает файлы по маске, в указанной папке. »
Поясните, пожалуйста, что Вы подразумеваете под маской и по какому принципу переименовываются файлы. Совершенно не хочется копаться в Вашем коде и догадываться о том, какие исходные данные вводятся вручную. Приведите примеры маски, и как найденные по этой маске файлы должны быть переименованы. Есть ли вероятность того, что имя файла после переименования совпадёт с уже имеющимся? Как поступать в этом случае?
Вот пример рекурсии, но чтобы довести этот мой скрипт, найденный у меня в архиве, до Ваших требований, необходимо их иметь во внятном виде
Код: Выделить весь код
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" и её подпапках

-------
Даже самая сложная проблема обязательно имеет простое, лёгкое для понимания, неправильное решение. Каждое решение плодит новые проблемы.


Последний раз редактировалось megaloman, 25-04-2017 в 09:50.

Это сообщение посчитали полезным следующие участники:

Отправлено: 09:34, 25-04-2017 | #3


Новый участник


Сообщения: 3
Благодарности: 0

Профиль | Отправить PM | Цитировать


Цитата megaloman:
Есть вот такой скрипт, переименовывает файлы по маске, в указанной папке. »
Поясните, пожалуйс »
Каталог в подпапками и файлами вида *.jpg. Сначала, я ввожу в модальном окне имена файлов которые нужно переименовать, начинающихся, скажем на xxx111.jpg. Затем, во втором модальном окне ввожу, на что переименовывать файлы, например yyy111.jpg.
Все файлы с уникальными именами, совпадений в пределах одной папки нет. В случае если файлы с одинаковыми именами встретятся в разных подпапках - переименовываются согласно вводным данным.

Отправлено: 17:21, 25-04-2017 | #4


Ветеран


Contributor


Сообщения: 2703
Благодарности: 1683

Профиль | Отправить PM | Цитировать


wwtf, как я понял, Вы вводите xxx и yyy, а затем переименовываете файлы, содержащие в названии ххх, например, xxx111.jpg в yyy111.jpg. Или, например, траляляxxx111.jpg в траляляyyy111.jpg
Вот вариант решения. По максимуму использовал Ваш скрипт
Код: Выделить весь код
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

-------
Даже самая сложная проблема обязательно имеет простое, лёгкое для понимания, неправильное решение. Каждое решение плодит новые проблемы.


Последний раз редактировалось megaloman, 26-04-2017 в 09:26.

Это сообщение посчитали полезным следующие участники:

Отправлено: 23:18, 25-04-2017 | #5


Новый участник


Сообщения: 3
Благодарности: 0

Профиль | Отправить PM | Цитировать


Цитата megaloman:
как я понял, Вы вводите xxx и yyy, а затем переименовываете файлы, »
Да, выбираю файлы, содержащие xxx в имени и меняю на любое другое значение. Ваш вариант рабочий, то что нужно, спасибо!
Только один момент, подтверждение о переименовании каждого файла, как его отключить?
В идеале добавить счетчик, такое-то количество файлов было переименовано.

Отправлено: 12:41, 26-04-2017 | #6


Ветеран


Contributor


Сообщения: 2703
Благодарности: 1683

Профиль | Отправить PM | Цитировать


Цитата wwtf:
Только один момент, подтверждение о переименовании каждого файла, как его отключить?
В идеале добавить счетчик, такое-то количество файлов было переименовано. »
Добавил счётчик и сделал настройку времени вывода сообщений
Код: Выделить весь код
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

-------
Даже самая сложная проблема обязательно имеет простое, лёгкое для понимания, неправильное решение. Каждое решение плодит новые проблемы.

Это сообщение посчитали полезным следующие участники:

Отправлено: 14:00, 26-04-2017 | #7



Компьютерный форум OSzone.net » Программирование, базы данных и автоматизация действий » Скриптовые языки администрирования Windows » VBS/WSH/JS - VBS Скрипт переименования файлов

Участник сейчас на форуме Участник сейчас на форуме Участник вне форума Участник вне форума Автор темы Автор темы Шапка темы Сообщение прикреплено

Похожие темы
Название темы Автор Информация о форуме Ответов Последнее сообщение
PowerShell - Простой скрипт переименования полей юзера в AD butylin Скриптовые языки администрирования Windows 3 02-07-2013 19:42
VBS/WSH/JS - нужен vbs скрипт для отпраки файлов на mail exekill Скриптовые языки администрирования Windows 0 18-04-2012 16:28
CMD/BAT - Не срабатывает скрипт переноса файлов по размеру - !!! с условием переименования !!! dark-------13 Скриптовые языки администрирования Windows 0 19-03-2012 15:27
VBS/WSH/JS - Нужен VBS скрипт для поиска файлов по маске и копирование его в определенное место exekill Скриптовые языки администрирования Windows 0 17-03-2012 10:46
Скрипт автоматического переименования файлов mp3 Ламер Программирование в *nix 2 02-03-2011 19:59




 
Переход