'=============================================================
' Объединение выделенных папок в одну с комбинированным именем
' Параметры: %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, "\")