[megaloman]

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

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

Код:

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