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: Tue Jul 26, 2016 16:30    Post subject: Reply with quote

Hjkma
Исправил. Мин.

Add: Немного потестировать пришлось.
Code:
'=================== VBS ===================
' Переместить файлы из каталога под курсором
' в папки с именами соответствующих им масок
' Параметр: %V
'===========================================
Option Explicit: Dim Filt, Fold, FSO, ShAp, Items, Mask, Name, Path
'===================== Маски файлов через "|" =====================
Filt = "1*.*|*name*|name*.txt|name 1.txt|name 1*.txt|name *1.*|" &_
"*2*|2.txt|name2.txt|name 2.txt|name *2.txt|name 2*.*|name 2.*|" &_
"*3*.txt|name 3.*|name3.txt|name 4.txt|name *4*.txt|*5*|*5*.txt"
'==================================================================
Fold = WScript.Arguments(0)
Set FSO  = CreateObject("Scripting.FileSystemObject")
If Not FSO.FolderExists(Fold) Then WScript.Quit
Set ShAp = CreateObject("Shell.Application")
Set Fold = ShAp.NameSpace(Fold)
Set Items = Fold.Items
For Each Mask in Split(Filt, "|")
  Items.Filter 73920, Mask
  If Items.Count Then
    Name = Replace(Mask, "*", ChrW(-246))
    Path = Fold.Self.Path & "\" & Name
    If Not FSO.FolderExists(Path) Then Fold.NewFolder(Name)
    ShAp.NameSpace(Path).MoveHere Items
  End If
Next

_________________
Автору сборки TC Image (Andrey_A) настоятельно рекомендуется не распространять на иных ресурсах любую предоставленную мной где-либо техническую информацию по автоматизации и оптимизации в работе с ТС и системой.
View user's profile Send private message


Powered by phpBB © 2001, 2005 phpBB Group