Batya
|
 Posted: Mon Oct 24, 2011 17:27 Post subject: |
 |
|
| REIGAN в ЛС wrote: | | Вопрос- как сделать чтобы файлы с одинаковым названием переименовывались тоже? когда файлы с одинаковым названием попадают в папку скрипт выкидывает ошибку... |
| Code: | '================================================================================
' Переименование файлов в указанном каталоге с заданной периодичностью
' К имени файла добавляется приставка - имя родительского каталога
'================================================================================
Option Explicit
Dim Mydir, Mysleep, Delimiter, MyKey, NIP
Set NIP = CreateObject("Scripting.Dictionary")
'========== Изменяемые параметры ================================================
Mydir = "E:\PAGE STORE\" 'Сканируемый каталог
Delimiter = "_" 'Разделитель после приставки
Mysleep = 10000 'Пауза между сканированием в милисекундах
MyKey = "HKCU\Environment\RunningMyScript" 'Ключ в реестре
'Папки не обрабатываются
With NIP
.Add "Temp" , ""
.Add "HighRes", ""
.Add "LowRes" , ""
.Add "Quest" , ""
End With
'================================================================================
Dim FSO, WSH, MykeyValue
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = CreateObject("WScript.Shell")
MykeyValue = True
WSH.RegWrite MyKey, MykeyValue
Do While MykeyValue
FolderAction FSO.GetFolder(Mydir)
Wscript.Sleep Mysleep
MykeyValue = WSH.RegRead(MyKey)
Loop
WSH.RegDelete MyKey
Set NIP = Nothing
Set FSO = Nothing
Set WSH = Nothing
WScript.Quit
Sub FolderAction(pFolder)
Dim F
For Each F In pFolder.SubFolders
If Not NIP.Exists(F.Name) Then FolderAction F
Next
For Each F In pFolder.Files
FileAction F
Next
End Sub
Sub FileAction(pFile)
Dim PF, PFName, NewPath
On Error Resume Next
PF = FSO.GetParentFolderName(pFile.Path) & "\"
PFName = FSO.GetFileName(PF)
If InStr(1, pFile.Name, PFName & Delimiter, 1) <> 1 Then
NewPath = NextName(PF & PFName & Delimiter & pFile.Name)
pFile.Move NewPath
End If
On Error GoTo 0
End Sub
Function NextName(pPath)
Dim lPath, lName, lExt, li, lAdd
Const lQ = 1 'Минимальное количество цифр в номере
With CreateObject("Scripting.FileSystemObject")
lPath = .GetParentFolderName(pPath)
If lPath <> "" Then lPath = lPath & "\"
lName = .GetBaseName(pPath)
lExt = .GetExtensionName(pPath)
NextName = pPath
Do While .FileExists(NextName) Or .FolderExists(NextName)
li = li + 1
If li < 10^lQ Then
lAdd = Right(String(lQ, "0") & li, lQ)
Else
lAdd = li
End If
NextName = lPath & lName & "_" & lAdd & "." & lExt
Loop
End With
End Function |
_________________
Нет, я не сплю. Я просто медленно моргаю. |
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
