Lev

|
Posted: Wed Apr 08, 2009 15:09 Post subject: |
|
|
Скрипт, вариациями которого я пользуюсь, судя по когда-то вписанному году, уже лет пять. Не совсем то, что Вам надо, т.к. создает только одну папку, но для старта, надеюсь, подойдёт.
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 |
|
|