VBS Скрипт переименования файлов - Компьютерный форум OSzone.net

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)

- Скриптовые языки администрирования Windows (http://forum.oszone.net/forumdisplay.php?f=102)

- - VBS Скрипт переименования файлов (http://forum.oszone.net/showthread.php?t=326260)

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

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

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

Цитата:

Цитата 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

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

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

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

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

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

Цитата:

Цитата 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