Total Commander

Неужели это никому не интересно???
Такая важная ветка Smile

Еще как! Действительно, такой мощный инструмент! Я уже нашего Технического гуру (нашей компании) сюда заслал, что бы изучал материал!!!

Хоть и не я инициировал тему - все равно - КРУТО!!!

Спасибо всем!

REIGAN в ЛС писал(а):Вопрос- как сделать чтобы файлы с одинаковым названием переименовывались тоже? когда файлы с одинаковым названием попадают в папку скрипт выкидывает ошибку...

Код: Выделить всё

'================================================================================
' Переименование файлов в указанном каталоге с заданной периодичностью
' К имени файла добавляется приставка - имя родительского каталога
'================================================================================
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

Total Commander

Добавление имя каталога к именам выделенных файлов?

Не уходите! Все круто!