Flasher

|
Posted: Wed May 09, 2012 19:20 Post subject: |
|
|
Пробуем:
Code: | '=============================================================================
' Создание копий файла на указанной глубине вложенности в выделенных папках
' Приставка к имени копии файла = имени родительской папки
' Параметры: %L "<путь к файлу-шаблону>"
'=============================================================================
With WScript.Arguments
C = .Count : If .Count = 0 Then WScript.Quit
If C < 2 Then MsgBox "Укажите оба параметра!", 48
List = .Item(0) : Templ = .Item(1)
End With : Const M = 1
Msg Count, " копий файла:"
Msg Depth, ", определяющее глубину вложенности от корня диска:"
Sub Msg(Sum, Word)
L = vbNewline : Sum = ""
Do Until IsNumeric(Sum)
Sum = InputBox(L&L&L&L&L& "Введите число" & Word,_
"Создание копий на нужной глубине", 3)
If Trim(Sum) = "" Then WScript.Quit
Loop
End Sub
Set FSO = CreateObject("Scripting.FileSystemObject")
Name = FSO.GetFileName(Templ) : BName = FSO.GetBaseName(Templ)
Ext = FSO.GetExtensionName(Name)
With FSO.OpenTextFile(List, 1)
Do While Not .AtEndOfStream
F = Trim(.ReadLine)
If F <> "" Then
If FSO.FolderExists(F) Then ForFolders F, Depth, Count, Name, BName, Ext, Templ
End If
Loop : .Close
End With : Set FSO = Nothing : WScript.Quit
Sub ForFolders(Fold, D, Cnt, FName, BN, E, Tml)
Set SubF = FSO.GetFolder(Fold).SubFolders
If SubF.Count > 0 Then
For Each Folder in SubF
Max = UBound(Split(Folder, "\")) + 1
If Max = Abs(D) Then
FoldName = FSO.GetFileName(Folder) : BN1 = FoldName & "_" & BN
For i = 1 to Cnt
N1 = FoldName & "_" & FName : l = 0
Do While FSO.FileExists(Folder & "\" & N1)
l = l + 1
If l < 10^M Then PostFix = Right(String(M, "0") & l, M) Else PostFix = l
N1 = BN1 & " (" & PostFix & ")." & E
Loop
FSO.CopyFile Tml, Folder & "\" & N1
Next
ElseIf Max < Abs(D) Then ForFolders Folder, D, Cnt, FName, BN, E, Tml
End If
Next
End If
End Sub |
Last edited by Flasher on Sat May 12, 2012 19:40; edited 1 time in total |
|