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: Переместить файлы в папки с именем 1го символа 
Author Message
Flasher



PostPosted: Mon Nov 28, 2011 16:39    Post subject: Reply with quote

Code:
'=============================================================
' Переместить выделенные файлы в создаваемые при необходимости
' папки с именами первых символов имён файлов

' ! Если выбран один файл, то участвуют все файлы источника

' Параметры: %WL "<путь источника>" "<путь получателя>"
' Пример: %WL "%P" "%T"
'=============================================================
With WScript.Arguments
  If .Count = 0 Then WScript.Quit
  L = .Item(0) : P = .Item(1) : T = .Item(2)
End With
If Right(P, 1) <> "\" Then P = P & "\"
If Right(T, 1) <> "\" Then T = T & "\"
Set FSO = CreateObject("Scripting.FilesystemObject")
TF = Split(FSO.GetFile(L).OpenAsTextStream(1, -1).ReadAll, vbNewLine)
If Ubound(TF) = 1 Then
  For Each F in FSO.GetFolder(P).Files : Move F : Next
Else
  For Each F in TF
    If F <> "" Then : If FSO.FileExists(F) Then Move F : End If
  Next
End If
Set FSO = Nothing : WScript.Quit

Sub Move(Fl)
  Trg = T & Left(FSO.GetBaseName(Fl), 1)
  If Not FSO.FolderExists(Trg) Then FSO.CreateFolder Trg
  FSO.MoveFile Fl, Trg & "\"
End Sub


Last edited by Flasher on Thu Dec 01, 2011 11:20; edited 3 times in total
View user's profile Send private message


Powered by phpBB © 2001, 2005 phpBB Group