Flasher
|
 Posted: Sun May 06, 2012 21:23 Post subject: |
 |
|
| Code: | '•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
' Перемещение выделенных файлов в папки с тем же началом в имени,
' если под этот критерий подходит только одна папка в получателе
' Параметры:
' 1) %WL
' 2) "<путь назначения>"
' 3) <число первых совпавших символов> (при отсутствии вводим в окне)
' 4) <максимальное число символов> (0 - отключить; при отсутствии - в окне)
' Примеры:
' 1) %WL C:\Тест
' 2) %WL "%T" 3 0
' 3) %WL "%T" "" 6
' 4) %WL "%T" 5 20
' Автор - Flasher ©
'•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
With WScript.Arguments
C = .Count : If C = 0 Then WScript.Quit
On Error Resume Next
List = .Item(0) : Path = .Item(1)
If C < 3 Then
Num = "" : Chek Num, ""
Else
Num = .Item(2) : If Len(.Item(2)) = 0 Then Chek Num, ""
End If
If C < 4 Then
Max = "" : Chek Max, "МАКСИМАЛЬНОЕ "
Else
Max = .Item(3) : If Max = 0 Then Max = Num
End If
On Error Goto 0
If C < 2 Then : MsgBox "Укажите не менее 2-ух параметров!", 4144, _
"Рассортировка файлов по папкам" : WScript.Quit : End if
End With : If Right(Path, 1) <> "\" Then Path = Path & "\"
Sub Chek(Count, Word)
L = vbNewline
Do Until IsNumeric(Count)
Count = InputBox(L&L&L&L&L& "Введите " & Word & "число первых" & _
" символов в именах:", "Рассортировка файлов по папкам", 3)
If Trim(Count) = "" Then WScript.Quit
Loop
End Sub
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SbF = FSO.GetFolder(Path).SubFolders
Set NSp = CreateObject("Shell.Application").NameSpace(Path)
For Each F in Split(FSO.GetFile(List).OpenAsTextStream(1, -1).ReadAll, vbNewline)
If F > vbNullString Then
If FSO.FileExists(F) Then
For i = Num to Max
Start = Left(FSO.GetBaseName(F), i) : Set Items = NSP.Items
Items.Filter 32, Start & "*"
If Items.Count = 1 Then
For Each FF in SbF
If StrComp(Start, Left(FSO.GetFileName(FF), i), 1) = 0 Then
FSO.MoveFile F, FF & "\" : Exit For
End If
Next
End If : Set Items = Nothing
Next
End If
End If
Next : Set FSO = Nothing : Set NSP = Nothing : Set SbF = Nothing : WScript.Quit |
|
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
