Flasher
|
 Posted: Fri Dec 09, 2016 05:39 Post subject: |
 |
|
BeardFury78
Включая и активный каталог, я полагаю:
| Code: | '================================ VBS ================================
' Добавка к именам файлов в структуре активного каталога отсутствующих
' описаний, имеющихся в конце имени одного файла cхожей именной группы
'
' Условие: путь запуска - пустой
'=====================================================================
Option Explicit: Dim ShA, Dic, FSO, Rgx, Reg, CD
Set ShA = CreateObject("Shell.Application")
Set Dic = CreateObject("Scripting.Dictionary")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Rgx = New RegExp : Rgx.Pattern = "^[^ ]+?\d+_\d+\.[A-z]{1,4}$"
Set Reg = New RegExp : Reg.Pattern = "^([^ ]+?)\d+_\d+( .+\.)[A-z]{1,4}$"
CD = FSO.GetAbsolutePathName("")
If CD = FSO.GetParentFolderName(WScript.ScriptFullName) Then WScript.Quit
ForFolder CD: MsgBox "Выполнено!", 4160, " Групповое переименование "
Sub ForFolder(Path)
Dim Items, F, N1, N2, Itms, I, NN, Folder
Set Items = ShA.NameSpace(Path).Items
Items.Filter 73920, "*_* *.*"
If Items.Count Then
For Each F In Items
If Reg.Test(F) Then
With Reg.Execute(F)(0)
N1 = .Submatches(0) : N2 = .Submatches(1)
End With
If Not Dic.Exists(N1) Then
Set Itms = ShA.NameSpace(Path).Items
Itms.Filter 73920, N1 & "*_*.*"
If Itms.Count > 1 Then
Dic.Add N1, ""
For Each I In Itms
NN = FSO.GetBaseName(I) & N2 & FSO.GetExtensionName(I)
If Rgx.Test(I) And Not FSO.FileExists(I.Parent.Self._
Path & "\" & NN) Then FSO.GetFile(I.Path).Name = NN
Next
End If
End If
End If
Next: Dic.RemoveAll
End If: Items.Filter 73888, "*" : If Items.Count Then _
For Each Folder In Items : ForFolder Folder.Path : Next
End Sub |
_________________
Автору сборки TC Image (Andrey_A) настоятельно рекомендуется не распространять на иных ресурсах любую предоставленную мной где-либо техническую информацию по автоматизации и оптимизации в работе с ТС и системой.
Last edited by Flasher on Fri Dec 16, 2016 22:18; edited 12 times in total |
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
