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: Sat Sep 01, 2012 21:10    Post subject: Reply with quote

+ Тихий вариант:
Code:
'============================ VBS ============================
' Создание отсутствующих подкаталогов с заданным именем внутри
' выбранных папок с перемещением в них файлов в заданной маске
' Параметры: %WL <имя подкаталога> <маска>
' Пример:    %WL Images *.gif;*.jpg;*.jpeg;*.png;*.tif;*.tiff
'=============================================================
Option Explicit: Dim List, Name, Mask, Shell, Fd, Items, FN
With WSH.Arguments
  If .Count = 0 Then WSH.Quit
  List = .Item(0) : Name = .Item(1) : Mask = .Item(2)
End With : Set Shell = CreateObject("Shell.Application")
Set List = CreateObject("Scripting.FileSystemObject").OpenTextFile(List,,,-1)
Do: Fd = List.ReadLine
  If Right(Fd, 1) = "\" Then
    Set Items = Shell.NameSpace(Fd).Items
    Items.Filter 8256, Mask
    If Items.Count > 0 Then
      FN = Fd & Name : Shell.NameSpace(Left(Fd, 3)).NewFolder Mid(FN, 4)
      Shell.NameSpace(FN).MoveHere Items, 5652
    End If
  End If
Loop Until List.AtEndOfStream : List.Close
Set List = Nothing : Set Shell = Nothing
View user's profile Send private message


Powered by phpBB © 2001, 2005 phpBB Group