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: Sun May 06, 2012 12:03    Post subject: Reply with quote

Code:
'======================================================================
' Перемещение выделенных папок при условии нахождения в них файлов
' со всеми указанными расширениями
' Параметры: %WL "<путь назначения>" <фильтр расширений через запятую>
' Пример:    %WL "%T" txt,lst,log
'======================================================================
With WScript.Arguments
  C = .Count : If C = 0 Then WScript.Quit
  On Error Resume Next
  List = .Item(0) : Path = .Item(1) : Filt = .Item(2)
  On Error Goto 0
  If C < 3 Then : MsgBox "Укажите 3 параметра!", 4144 : Wscript.Quit : End if
End With : If Right(Path, 1) <> "\" Then Path = Path & "\"
Sp = Split(Filt,",") : Max = Ubound(Sp) + 1
Set FSO = CreateObject("Scripting.FileSystemObject")
For Each F in Split(FSO.GetFile(List).OpenAsTextStream(1, -1).ReadAll, vbNewLine)
  If F > vbNullString Then
    If FSO.FolderExists(F) Then
      With CreateObject("Shell.Application")
        Set P1 = .NameSpace(F).Items
        Set P2 = .NameSpace(Path)
      End With     
      If Len(Filt) > 0 Then
        For Each Fi in Sp
          P1.Filter 96, "*." & Fi : If P1.Count > 0 Then Ch = Ch + 1
        Next
        If Max = Ch Then
          Folder = Path & FSO.GetFileName(F) : P2.MoveHere F, 16
        End If : Ch = 0 : Set P1 = Nothing : Set P2 = Nothing
      End If
    End If
  End If
Next : Set FSO = Nothing : WScript.Quit
View user's profile Send private message


Powered by phpBB © 2001, 2005 phpBB Group