Monarch-LFV
|
 Posted: Tue May 24, 2022 11:39 Post subject: |
 |
|
К запросу:
Написал VBS скрипт по переименованию файлов и папок по любым правилам (можно прописывать в правилах свои хотелки):
Сейчас скрипт переименовывает:
- по вашей же регулярке удаляет все небуквы, нецифры и непробелы
- заменяет все подчеркивания "_" на пробелы
- заменяет все двойные, тройные и т.п. пробелы на одиночные пробелы
| Code: | '======================================================================
' Переименовать выделенные объекты по "своим" правилам
' Параметры:
' %WL
'======================================================================
Option Explicit
Dim FSO, objRegEx, FileList, List, F, k, fn, ext, path, i
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objRegEx = CreateObject("VBScript.RegExp")
FileList = WScript.Arguments(0)
List = Split(FSO.OpenTextFile(FileList,,,-1).ReadAll, vbNewLine)
For Each F In List
If F <> "" Then
path = FSO.getparentfoldername(F) & "\"
if FSO.FolderExists(F) then
fn = FSO.GetFolder(F).name ' Имя папки
F=left(F, len(F)-1) ' удаление последнего обратного слэша
k=1
else
fn = FSO.GetBaseName(F) ' Имя файла
ext = "." & FSO.GetExtensionName(F) ' Расширение файла
k=0
end if
' ======= ПРАВИЛА ПЕРЕИМЕНОВАНИЯ ==============================
objRegEx.Pattern = "[^\wА-Яа-яёЁ ]"
objRegEx.Global = True
fn = objRegEx.replace(fn, "")
fn=replace(fn, "_", " ")
for i=1 to 5 ' удаление всех задвоенных, затроенных и т.п. пробелов
fn=replace(fn, " ", " ")
next
' =============================================================
' Непосредственно переименование
if k=1 then
FSO.MoveFolder F, path & fn ' переименование папок
else
FSO.MoveFile F, path & fn & ext ' переименование файлов
end if
End If
Next |
|
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
