Monarch-LFV
|
 Posted: Wed Aug 30, 2023 14:14 Post subject: |
 |
|
keramer82
Делюсь своим скриптом VBS для расширенного создания папок, делал сугубо для своих нужд. Можете или пользоваться им, или просто подсмотреть решение:
| Code: | ' Расширенное создание папок
' Параметры "%P" (в кавычках)
' ============================
' Изменяемые в VBS параметры:
DelTire = 1 ' удаление " - " (пробел тире пробел) в конце имен папок, 0 - нет, 1 - да
' ============================
On Error Resume Next
set FSO = createobject ("Scripting.FileSystemObject")
DateNow = Year(Date) & "." & Right(0 & Month(Date), 2) & "." & Right(0 & Day(Date), 2) & " - "
Fld = Inputbox("Введите имя папки" & vbnewline & vbnewline & " * (звездочка) - создание папок по списку из буфера обмена" & vbnewline & " ** (две звездочки) - то же, но с сохранением порядка", "Расширенное создание папок", DateNow)
if IsEmpty(Fld) then Wscript.Quit
' ===== Обработка буфера обмена
if Fld="*" Or Fld="**" then
If Fld="**" then num = 1 else num = 0
Fld = CreateObject("HTMLFile").parentWindow.clipboardData.getData("Text")
CrLfArr = Array(vbnewline, chr(13), chr(10), "||")
For Each a In CrLfArr
Fld = replace(Fld, a, "|")
Next
Fld = replace(Fld, Chr(9) & "|", "|")
Fld = replace(Fld, Chr(9), " - ")
Fld = replace(Fld, """", "")
End If
' ===== замена запрещенных символов
Sym = "/\*?"":<>"
For i = 1 To Len(Sym)
Fld = Replace(Fld, Mid(Sym, i, 1), "_")
Next
For i=1 to 100
Fld = replace(Fld, " ", " ")
Fld = replace(Fld, "- -", "-")
Next
Fld = replace(Fld, " - |", "|")
' ===== Основная обработка создания папок
For Each FldName In Split(Fld, "|")
QuantityFlds = QuantityFlds + 1 ' общий счет количества создаваемых папок
If num = 1 then
k = k + 1
number = right("000" & k, 4) & ". "
End If
Err.Number = 0
if right(FldName, 3) = " - " and DelTire = 1 then FldName=left(FldName, len(FldName) - 3)
FullpathNewFolder = WScript.Arguments(0) & number & Trim(FldName)
If FldName <> "" then FSO.CreateFolder FullpathNewFolder
If Err.Number <> 0 then ErrText = ErrText & vbnewline & "• " & number & Trim(FldName)
Next
' ===== сообщение об ошибке при создании папок
If ErrText <> "" then
msgbox "Ошибка создания папок, возможны следующие причины:" & vbnewline & " 1) Папки уже существуют" _
& vbnewline & " 2) Вы пытаетесь создать папки с одинаковыми именами" & vbnewline _
& " 3) Превышение максимальной длины пути" & vbnewline & ErrText
Wscript.Quit
end if
' ===== если созданная папка ОДНА, то автоматический вход в нее в ТС
If QuantityFlds = 1 then
Set WshShell = CreateObject("WScript.Shell")
TCP = WshShell.ExpandEnvironmentStrings("%commander_path%")
WshShell.run """" & TCP & "\TOTALCMD.EXE"" /O /S """ & FullpathNewFolder & """"
End If |
|
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
