Flasher
|
 Posted: Wed Mar 29, 2017 18:52 Post subject: |
 |
|
BeardFury78
Вроде того, но особо не тестировал:
| Code: | '=============================================================
' Объединение выделенных папок в одну с комбинированным именем
' Параметры: %WL "<путь получателя>" "<разделитель имён>"
' Пример: %WL "%T" " - "
'=============================================================
With WSH.Arguments
C = .Count : If C = 0 Then WSH.Quit
If C <> 3 Then MsgBox "Укажите 3 параметра!", 4144 : WSH.Quit
List = .Item(0) : Targ = .Item(1) : Delim = .Item(2)
End With : Set ShA = CreateObject("Shell.Application")
Set FSO = CreateObject("Scripting.FileSystemObject")
With New RegExp
.Pattern = "(^|\r\n).+[^\\](?=\r\n)" : .Global = True
List = .Replace(FSO.OpenTextFile(List,,,-1).ReadAll, "")
List = Left(List, Len(List) - 2)
If InStr(List, vbNewLine) = 0 Then WSH.Quit
.MultiLine = True : .Pattern = "\\$"
Name = .Replace(List, "") : .Pattern = "^.+\\"
Name = Replace(.Replace(Name, ""), vbNewLine, Delim)
End With : List = Split(List, vbNewLine)
With FSO.GetFolder(List(0)) .Name = Name : Path = .Path End With
Set oPath = ShA.NameSpace(Path) : On Error Resume Next
For i = 1 To Ubound(List)
Fd = List(i) : Set Items = ShA.NameSpace(Fd).Items
Items.Filter 73952, "*" : oPath.MoveHere Items, 4120
Set Fd = FSO.GetFolder(Fd) : If Fd.Size = 0 Then Fd.Delete
Next : If StrComp(Path, FSO.BuildPath(Targ, Name)) Then _
FSO.MoveFolder Path, FSO.BuildPath(Targ, "\") |
_________________
Автору сборки TC Image (Andrey_A) настоятельно рекомендуется не распространять на иных ресурсах любую предоставленную мной где-либо техническую информацию по автоматизации и оптимизации в работе с ТС и системой.
Last edited by Flasher on Wed Mar 29, 2017 23:18; edited 2 times in total |
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
