Total Commander Forum Index Total Commander
Форум поддержки пользователей Total Commander
Сайты: Все о Total Commander | Totalcmd.net | Ghisler.com | RU.TCKB
 
 RulesRules   SearchSearch   FAQFAQ   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

Single Post  Topic: Автоматическое создание папок 
Author Message
Flasher



PostPosted: Wed Oct 12, 2011 10:16    Post subject: Reply with quote

Code:
'======================================================================
' Перемещать файлы и папки, указанные в файлах-списках
' в папки с базовыми именами этих файлов-списков
' Параметры: %L <путь_назначения\>
' Пример: %L "%T"
'======================================================================
L = vbNewLine
D = InputBox(L&L&L&"Введите число отсекаемых компонентов " & L &_
"в началах путей, записанных" & L & "в выделенные файлы :",_
Space(13) & "Перемещение файлов и папок по спискам")
If Trim(D) = "" Or Not IsNumeric(D) Then Wscript.Quit

With CreateObject("Scripting.FileSystemObject")
  Set TF = .OpenTextFile(WScript.Arguments(0), 1)
  Do While Not TF.AtEndOfStream
    F = TF.ReadLine
    If F > vbNullString And .FileExists(F) Then
      Trg = WScript.Arguments(1) & .GetBaseName(F)
      If Not .FolderExists(Trg) Then .CreateFolder Trg
      For Each Fn in Split(.OpenTextFile(F, 1).ReadAll, vbNewLine)
        Fn = Trim(Fn)
        If Fn <> "" And Mid(Fn, 2, 1) = ":" Then
          Fx = Fn
          Do While Abs(D) =< Abs(Ubound(Split(Fx, "\")))
            Fx = .GetParentFolderName(Fx)
          Loop
          FPath = Trg & "\" & .GetParentFolderName(Mid(Fn, Len(Fx)+2))
          If Not .FolderExists(FPath) Then .CreateFolder FPath
          If .FolderExists(Fn) Then .GetFolder(Fn).Move FPath & "\"
          If .FileExists(Fn) Then .GetFile(Fn).Move FPath & "\"
        End If
      Next
    End If
  Loop
  TF.Close
End With


Last edited by Flasher on Wed Oct 12, 2011 17:16; edited 7 times in total
View user's profile Send private message


Powered by phpBB © 2001, 2005 phpBB Group