Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Поиск дубликатов файлов в каталогах (подкаталогах) и переименование дублей
 
#1
18.03.2022 19:28:59
Добрый вечер!

Прошу такой помощи по VBA, т.к. не смог найти решение в инете:
в структуре связанных каталогов могут находится дубликаты наименований файлов. Дублей может быть несколько в разных каталогах. Задача, указав родительский каталог, исключить дубли наименований, переименовав автоматически дубликаты, добавив к наименованию второго файла числовой индекс, например "Имя(2)", третьему "Имя(3)" и т.д. Первое имя из группы дублей оставить без изменения. Содержимое и размер дублей не анализировать.
Пример каталогов с файлами показываю.

Полное имя файла Путь
1.txt                         C:\Users\admin\Desktop\Каталог1\1.txt
2.txt                   C:\Users\admin\Desktop\Каталог1\2.txt
3.txt                 C:\Users\admin\Desktop\Каталог1\3.txt
3.txt                       C:\Users\admin\Desktop\Каталог1\Каталог2\3.txt
1.txt                        C:\Users\admin\Desktop\Каталог1\Каталог2\Каталог3\1.txt
2.txt                       C:\Users\admin\Desktop\Каталог1\Каталог2\Каталог3\2.txt
4.txt                       C:\Users\admin\Desktop\Каталог1\Каталог2\Каталог3\4.txt
 
 
 
#2
18.03.2022 22:47:05
Для такой задачи больше подходит Total Commander или другой файловый менеджер...
Там можно и отобразить все файлы без подкаталогов, и найти/выделить нужные с помощью регулярных выражений, и по маске переименовать.
Быстро, удобно. Но, не VBA, увы )
 
 
 
#3
19.03.2022 08:34:45
чисто гипотетически ничего сложного. Обход дерева каталога, наполнение именами файлов словаря с увеличением значения  при совпадении с уже имеющимся и переименованию  с добавлением индекса.
Можно список файлов получить сразу через shell и DIR и обрабатывать массив.
По вопросам из тем форума, личку не читаю.
 
 
 
#4
19.03.2022 08:37:37
https://excelvba.ru/code/FilenamesCollection
http://www.excelworld.ru/forum/3-1894-1
Изменено: RAN - 19.03.2022 08:39:02
 
 
 
#5
19.03.2022 08:59:28
RAN, благодарю за ссылки. Перечень всех файлов в каталогах умею создавать - Николай Павлов четко показал.. Не нахожу (мб не вижу) способ переименования 2го, 3го и  т.д. файла в группе одинаковых наименований. Пожалуйста, ткните носом)
 
 
 
#6
19.03.2022 10:32:35
выполните FilesRename
Код
Sub FilesRename()
  Dim fso, fr, fs, cnt&
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set fs = CreateObject("Scripting.Dictionary")
  Set fr = fso.getfolder("C:\Users\admin\Desktop\Каталог1")  ' Стартовый каталог
  RenameAllIn fr, fs, fso, cnt
  MsgBox "Переименовано файлов: " & cnt & " шт.", , "Готово!"
End Sub

Sub RenameAllIn(ByVal fr, fs, fso, cnt)
  Dim fls, f, N&, dN&, nm, ex, pt
  Set fls = fr.Files
  For Each f In fls
    If fs.Exists(f.Name) Then
      fs(f.Name) = fs(f.Name) + 1: N = fs(f.Name): cnt = cnt + 1
      ex = fso.GetExtensionName(f.Path)
      nm = fso.GetBaseName(f.Path) & "(" & N & ")"
      pt = fso.GetParentFolderName(f.Path) & Application.PathSeparator
      If fso.FileExists(pt & nm & "." & ex) Then
        Do While fso.FileExists(pt & nm & dN & "." & ex)
          dN = dN + 1
        Loop
        nm = nm & dN
      End If
      f.Name = nm & "." & ex
    Else
      fs(f.Name) = 0
    End If
  Next
  If fr.SubFolders.Count = 0 Then Exit Sub
  Set fr = fr.SubFolders
  For Each f In fr
    RenameAllIn f, fs, fso, cnt
  Next
End Sub
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#7
19.03.2022 11:37:16
Ігор Гончаренко, от души! Благодарствуете! Очень помогли - код отрабатывает так, как нужно.
 
 
 
#8
19.03.2022 15:06:33
Ігор Гончаренко, Игорь, dN точно не забыл обнулить? Правда и в целом такой методе делает вроде не одинаковые в прошлом имена , одинаковыми.

ну и крохотная оптимизация
F.ParentFolder.Path вместо fso.GetParentFolderName(f.Path)
да и не нужно оно ибо в пределах одной подпрограммы обрабатывается один каталог и он уже определен в FR

Код
If fr.SubFolders.Count = 0 Then Exit Sub
  Set fr = fr.SubFolders
  For Each f In fr
    RenameAllIn f, fs, fso, cnt
  Next

разве не

Код
  For Each f In fr.SubFolders
    RenameAllIn f, fs, fso, cnt
  Next
По вопросам из тем форума, личку не читаю.
 
 
 
Страницы: 1
Наверх