'================================= VBS ================================
' Алгоритм действий скрипта:
' 1) Удаление <пробел>(*) справа базовых имён файлов структуры рабочего
'    каталога с автозаменой при совпадении имён с существующими файлами
' 2) Удаление в структуре рабочего каталога <пробел>(*) справа
'    имён каталогов при отсутствии таковых без удаляемой части
' 3) Перемещение с автозаменой содержимого из каталогов текущего
'    уровня с наличием в именах <пробел>(*) в каталоги без оного
' 4) Удаление опустошённых каталогов

' Условие: путь запуска — пустой
'======================================================================
Option Explicit : Dim FSO, ShA, Dir, Items, Itms, Fd
Set ShA = CreateObject("Shell.Application")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Dir = ShA.NameSpace(FSO.GetAbsolutePathName(""))
If StrComp(Dir.Self.Path,_
FSO.GetParentFolderName(WSH.ScriptFullName),1) = 0 Then WSH.Quit
FFolder Dir : Set Items = Dir.Items: Items.Filter 73888, "* (*)"
For Each Fd In Items
  Set Itms = Fd.GetFolder.Items
  ShA.NameSpace(Left(Fd.Path, InStrRev(Fd.Path, " (") - 1)).MoveHere Itms, 5652
  If Fd.GetFolder.Items.Count = 0 Then FSO.DeleteFolder Fd.Path, 1
Next
For Each Fd in Array(Itms, Items, Dir, ShA, FSO)
  Set Fd = Nothing
Next
MsgBox Space(29) & "Выполнено!", 4160,_
"Масштабное обрезание имён объектов с автозаменой      "

Sub FFolder(Fold)
  Path = Fold.Self.Path
  Set Items = Fold.Items
  Items.Filter 73920, "* (*)*"
  Dim F, FPath, Ext, NName, Path, Name, FdPath
  For Each F in Items
    FPath = F.Path
    Ext = FSO.GetExtensionName(FPath)
    If Ext <> "" Then Ext = "." & Ext
    NName = Split(FSO.GetBaseName(FPath), " (")(0) & Ext
    If   FSO.FileExists(Path & "\" & NName) _
    Then FSO.DeleteFile Path & "\" & NName, 1
    F.Name = NName
  Next : Items.Filter 73888, "*"
  For Each Fd In Items
    Name = Fd.Name : FdPath = Fd.Path : FFolder Fd.GetFolder
    If InStr(Name, "(") Then
      NName = Split(FSO.GetFileName(FdPath), " (")(0)
      If Not FSO.FolderExists(Path & "\" & NName) Then Fd.Name = NName
    End If
  Next
End Sub