Flasher
|
 Posted: Sat Sep 10, 2011 19:37 Post subject: |
 |
|
| DocWeb wrote: | может поможет то, что есть список папок-приемников.
например в виде файла его можно иметь... |
Да, такой вариант подходит.
| DocWeb wrote: | | да, можно в принципе сами папки по ходу выполнения операции создавать. |
Ну, если уж список заведомо известен, то можно и создавать поддиректории.
| Code: | '================================================================
' Рассортировка выделенных файлов по папкам (или их подкаталогам),
' выделенным в другой панели или указанным в файле, по частям
' Необходима регистрация Script Helper ActiveX for TC
' Параметры:
' 1) %L
' 2) <путь к списку> Если "", то использовать папки неактивной панели
' 3) <имя подпапки> Если "", то перемещать в корни папок-приёмников
' 4) <делящее число> Если отсутствует, то указывается в окне
' Примеры:
' a) %L "" ""
' б) %L "" "" 5
' в) %L "" NEWS 10
' г) %L C:\FolderList.txt "Моя папка" 15
'================================================================
With WScript.Arguments
On Error Resume Next
List = .Item(0)
pList = .Item(1)
SubF = .Item(2)
If Err.Number > 0 Then WScript.Quit
NL = vbNewLine
If .Count > 3 Then Div = .Item(3) Else Count Div, NL
End With
Do While Not IsNumeric(Div) And Trim(Div) > vbNullString
W = MsgBox("Некорректный ввод данных !" & NL & NL & _
"Повторить попытку ?", 53, " Перемещение файлов по папкам")
If W = 4 Then Count Div, NL Else WScript.Quit
Loop
If Div = vbNullString Or Div = 0 Then WScript.Quit
Div = Abs(Fix(Div))
Set D = CreateObject("Scripting.Dictionary")
With CreateObject("Scripting.FileSystemObject")
If pList = "" Then
With CreateObject("TCScript.Helper")
.LockTC True
L = .GetTrgSelectedFiles(1)
.LockTC False
End With
Else L = Split(.OpenTextFile(pList).ReadAll, vbNewLine)
End If
n = 0
For Each P in L
n = n + 1
If P > vbNullString Then D.Add P, n
Next
Set TempFile = .OpenTextFile(List, 1)
Do While Not TempFile.AtEndOfStream
F = TempFile.ReadLine
If F > vbNullString Then
If .FileExists(F) Then
For Each k in D.Keys
If k <> "" And Fix((TempFile.Line-2)/Div)+1 = D.Item(k) Then
k = Trim(k)
If Right(k, 1) <> "\" Then k = k & "\"
If SubF = "" Then SF = k Else SF = k & SubF & "\"
If Not .FolderExists(k) Then .CreateFolder k
If Not .FolderExists(SF) Then .CreateFolder SF
.MoveFile F, SF
End If
Next
End If
End If
Loop
End With
WScript.Quit
Sub Count(Di, n)
Di = InputBox(n&n&n&n& "Введите число файлов," &n&_
"перемещаемых в каждую папку :",_
Space(22) & "Перемещение файлов по папкам")
End Sub |
Last edited by Flasher on Wed Sep 28, 2011 10:24; edited 5 times in total |
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
