| View previous topic :: View next topic |
| Author |
Message |
Toni
Joined: 13 Jul 2005
Posts: 26
|
 (Separately) Posted: Sat Nov 26, 2005 13:57 Post subject: Не уходите! Все круто! |
 |
|
| Quote: | Неужели это никому не интересно???
Такая важная ветка Smile |
Еще как! Действительно, такой мощный инструмент! Я уже нашего Технического гуру (нашей компании) сюда заслал, что бы изучал материал!!!
Хоть и не я инициировал тему - все равно - КРУТО!!!
Спасибо всем! |
|
| Back to top |
|
 |
Batya
Joined: 15 Dec 2004
Posts: 2218
Location: Москва, Россия
|
| (Separately) 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 |
_________________
Нет, я не сплю. Я просто медленно моргаю. |
|
| Back to top |
|
|
|
|
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
|
Powered by phpBB © 2001, 2005 phpBB Group
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
