Total Commander

Код: Выделить всё

'======================================================================
' Очищается каждая папка из файла-списка:
' файлы перемещаются в папку выше уровнем.
' При совпадении имён файлов выполняется автоматическое переименование.
' После выполнения переноса очищенные папки удаляются.
'
' Параметры:
' {файл-список}
'
' Пример параметров при вызове из TC:
' %L
'======================================================================
Option Explicit
Dim FSO, FF, F, oF

With WScript
  If .Arguments.Count = 0 Then
    MsgBox "Не заданы параметры!", vbOKOnly + vbCritical, "Очистка папок"
    .Quit
  End If
  FF = .Arguments(0)
End With

Set FSO = CreateObject("Scripting.FileSystemObject")

With FSO.OpenTextFile(FF, 1)
  Do While Not .AtEndOfStream
    F = Trim(.ReadLine)
    If F <> "" Then
      If FSO.FolderExists(F) Then
        Set oF = FSO.GetFolder(F)
        On Error Resume Next 
        MoveFromFolder oF, oF.ParentFolder
        If Err.Number = 0 Then FSO.DeleteFolder oF.Path
        Err.Clear
        On Error GoTo 0
      End If
    End If
  Loop
  .Close
End With

Set FSO = Nothing
WScript.Quit

Sub MoveFromFolder(pSubFolder, pFolder)
  Dim lF
  For Each lF In pSubFolder.Files
    MoveFile lF, pFolder
  Next
  For Each lF In pSubFolder.SubFolders
    MoveFromFolder lF, pFolder
    FSO.DeleteFolder lF.Path
  Next
End Sub

Sub MoveFile(pFile, pFolder)
  Dim lF
  lF = pFolder
  If Right(lF, 1) <> "\" Then lF = lF & "\"
  lF = NextName(lF & pFile.Name)
  FSO.MoveFile pFile.Path, lF
End Sub

Function NextName(pFilePath)
  Dim lPath, lName, lExt, li, lAdd
  Const lQ = 1 'Минимальное количество цифр в номере
  With CreateObject("Scripting.FileSystemObject")
    lPath = .GetParentFolderName(pFilePath)
    If lPath <> "" Then lPath = lPath & "\"
    lName    = .GetBaseName(pFilePath)
    lExt     = .GetExtensionName(pFilePath)
    NextName = pFilePath
    Do While .FileExists(NextName)
      li = li + 1
      If li < 10^lQ Then
        lAdd = Right(String(lQ, "0") & li, lQ)
      Else
        lAdd = li
      End If
      NextName = lPath & lName & "(" & lAdd & ")." & lExt
    Loop
  End With
End Function

Код: Выделить всё

Сценарий:	F:\total\Utils\test\3.vbs
Строка:	24
Символ:	10
Ошибка:	Файл уже существует
Код:	800A003A

Код: Выделить всё

H:\Cache\cdn.clara-g.com\CLARA-CZ1-A-003\SplittedVideos\5CLARA-CZ1-A-003-part5\
H:\Cache\cdn.clara-g.com\CLARA-CZ1-A-003\SplittedVideos\6CLARA-CZ1-A-003-part6\

Код: Выделить всё

 5CLARA-CZ1-A-003-part5\ и 6CLARA-CZ1-A-003-part6\