Rodny
Silver Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Код: '==============================================================================
' AutoMultiRename3.5.vbs
'
' Переименовать файл или папку (выделенную группу файлов или папок в разных папках)
' заданным образом без дополнительных окон и вопросов
' http://forum.ru-board.com/topic.cgi?forum=5&topic=33904&start=3120#8
' http://forum.ru-board.com/topic.cgi?forum=5&topic=33904&start=4120&limit=1
' Продолжение:
' http://forum.ru-board.com/topic.cgi?forum=5&topic=45288&start=3360#17
'
' Параметры для кнопки:
' %L "новое имя объекта" 1
'
' Если присутствует необязательный третий параметр, то второй параметр считается именем файла, расширение файла сохраняется.
' Если при этом файл с новым именем существует, к имени добавляется "_001", "_002" и т.д. до _999
'
' Путь запуска должен быть пустым!
' Rodny (с)
'==============================================================================
Option Explicit
Dim FSO, ListFile, CurrentLine, CurrentFile, FileName, FileExt, FilePath, NewFileName, ExtMode
If WScript.Arguments.Count = 0 Then
MsgBox "Параметры кнопки не заданы!", vbOKOnly + vbExclamation, "Внимание!"
WScript.Quit
End If
If WScript.Arguments.Count = 3 Then
ExtMode = 1
Else ExtMode = 0
End If
Set FSO = CreateObject("Scripting.FileSystemObject")
Set ListFile = FSO.OpenTextFile(WScript.Arguments(0), 1)
NewFileName = WScript.Arguments(1)
Do While Not ListFile.AtEndOfStream
CurrentLine = ListFile.ReadLine
If Right(CurrentLine, 1) <> "\" Then ' Это файл
Set CurrentFile = FSO.GetFile(CurrentLine)
Else ' Это папка
Set CurrentFile = FSO.GetFolder(CurrentLine)
End If
FileName = FSO.GetBaseName(CurrentFile)
FileExt = FSO.GetExtensionName(CurrentFile)
FilePath = CurrentFile.ParentFolder
If ExtMode <> 0 Then
If UCase(FileName)=UCase(NewFileName) Then
CurrentFile.Move FilePath & "\" & NewFileName & "." & FileExt
Else
If Not (FSO.FileExists(FilePath & "\" & NewFileName & "." & FileExt)) Then
CurrentFile.Move FilePath & "\" & NewFileName & "." & FileExt
Else
CurrentFile.Move FilePath & "\" & GetNewName(FilePath, NewFileName & "." & FileExt)
End If
End If
Else
If Not (FSO.FileExists(FilePath & "\" & NewFileName) Or FSO.FolderExists(FilePath & "\" & NewFileName)) Then
CurrentFile.Move FilePath & "\" & NewFileName
Else
MsgBox "Файл или папка """ & NewFileName & """ уже существует в папке """ & FilePath & """", vbOKOnly + vbExclamation, "Внимание!"
End If
End If
Loop
Function GetNewName(Path, Name)
Dim i, NewName, FileN, FileE
i = 0
Do
i = i + 1
FileN = FSO.GetBaseName(Path & "\" & Name)
FileE = FSO.GetExtensionName(Path & "\" & Name)
If i < 10 Then
NewName = FileN & "_00" & CStr(i) & "." & FileE
ElseIf (i >= 10 and i < 100) Then
NewName = FileN & "_0" & CStr(i) & "." & FileE
ElseIf (i >= 100 and i < 1000) Then
NewName = FileN & "_" & CStr(i) & "." & FileE
End If
Loop Until Not (FSO.FileExists(Path & "\" & NewName) Or FSO.FolderExists(Path & "\" & NewName))
GetNewName = NewName
End Function
Set FSO = Nothing
Set ListFile = Nothing
Set CurrentFile = Nothing
Wscript.Quit |
|
Всего записей: 2877 | Зарегистр. 28-07-2006 | Отправлено: 02:48 10-08-2014 | Исправлено: Rodny, 14:21 10-08-2014 |
|
