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
Lev



PostPosted: Wed Apr 08, 2009 15:09    Post subject: Reply with quote

Скрипт, вариациями которого я пользуюсь, судя по когда-то вписанному году, уже лет пять. Не совсем то, что Вам надо, т.к. создает только одну папку, но для старта, надеюсь, подойдёт.
Code:
'  File:         namedir.vbs
'  Version:      1.0 beta
'  Description:  Все файлы выделенные в одном окне передвигаются в новую папку во втором окне с именем
'             общей части первых двух файлов выделения начиная с начала, если совпадение не находится,
'             то с именем первого файла в выделении
'  (c) 2004, Lev F

Dim TCS, f, ff, NewDir, FSO, nn, n, counter, fcount, tf
Set TCS = CreateObject("TCScript.Helper")

Set FSO = CreateObject("Scripting.FileSystemObject")

ff = TCS.GetSrcSelectedFiles(-1)
if UBound(ff)=0 Then
   f0=fso.GetBaseName(ff(0))
Else
   f0=FSO.GetFile(ff(0)).Name
   f1=FSO.GetFile(ff(1)).Name
   ln=1
   While Mid(f0,1,ln)=Mid(f1,1,ln)
     ln=ln+1
   wend
   If ln<>1 Then f0=Mid(f0,1,ln)
   lastlet=Mid(f0,ln,1)
   while lastlet="0" Or lastlet="-" Or lastlet="_" Or lastlet="(" Or lastlet="[" Or lastlet=" " Or lastlet="."
      ln=ln-1
      lastlet=mid(f0, ln,1)
      ch=true
   wend
   If ch Then f0=Mid(f0,1,ln)
End If
inp=InputBox ("Enter DirName",,f0)
If inp<>"" then

   NewDir = TCS.GetTrgPath & "\" & inp & "\"
   MsgBox NewDir
   If Not FSO.FolderExists(NewDir) Then FSO.CreateFolder(NewDir)
   For i = 0 to ubound(ff)
      fcount = 1
      Set tf = FSO.GetFile(ff(i))
      Do While FSO.FileExists(NewDir + tf.Name)
         nn = tf.Name
         n = InStrRev(nn, ".")
         If n <> 0 Then
            nn = Left(nn, n - 1)
         End If

         tf.Name = nn & "_" & fcount & "." & FSO.GetExtensionName(tf)
         fcount = fcount + 1
      Loop
      If FSO.fileexists(tf) Then tf.Move NewDir
   Next
   TCS.SendCommand "cm_ClearAll"
End If
Set FSO = Nothing
Set TCS = Nothing
View user's profile Send private message


Powered by phpBB © 2001, 2005 phpBB Group