Всем доброго времени суток. Ситуация следующая. Есть куча папок с названиями организаций. В каждой папке лежит одна книга. Название книг всюду одинаковые. В редких случаях им присвоены какие-то другие имена. Задача: переименовать книги по названию папок, в которых они лежат. Можно поместить результат в одну общую папку, это не принципиально.
Chistomaster
Пользователь
Сообщений: Регистрация: 23.12.2012
28.10.2010 17:23:36
Сначала считываете все пути к файлам из подпапок этой функцией:
Потом в цикле перебираем все файлы, и переименовываем
Неохота воссоздавать вашу структуру папок для тестирования макроса... Да ещё и угадывать путь к корневой папке... (или надо выводить диалоговое окно выбора корневой папки)?
Пользователь
Сообщений: Регистрация: 23.12.2012
28.10.2010 17:35:58
Вот вам макрос:
Sub ПереименованиеФайлов() ' обзор папок начинается с папки "Рабочий стол" СтартоваяПапка = CreateObject("WScript.Shell").SpecialFolders("Desktop") ПутьКПапке = GetFolderPath("Выберите папку для переименовая файлов", СтартоваяПапка) If ПутьКПапке = "" Then Exit Sub ' выход, если пользователь отказался от выбора папки
' Ищем в выбранной папке все файлы XLS ' считываем в колекцию coll нужные имена файлов Dim coll As Collection: Set coll = FilenamesCollection(ПутьКПапке, ".xls")
For Each file In coll ' переименование файлов в цикле Расширение = Split(file, ".")(UBound(Split(file, "."))) ИмяПапки = Split(file, "\")(UBound(Split(file, "\")) - 1) ' переименование файла НовыйПутьКФайлу = Replace(file, Dir(file), ИмяПапки & "." & Расширение) Name file As НовыйПутьКФайлу Next MsgBox "Готово", vbInformation End Sub
А вот - пример файла с этим макросом: Нажмите кнопочку, выберите папку, - и все файлы переименуются.
Не забудьте перед тестированием создать копию обрабатываемой папки.
Пользователь
Сообщений: Регистрация: 01.01.1970
28.10.2010 18:20:40
EducatedFool Спасибо! Попробую разобраться с этим!
