переименование файлов в папке макросом из Excel

[xamillion]

Сообщение от EducatedFool

    Предприятие = Replace([a4], """", "'")    ' заменяем двойные кавычки одинарными '
    If IsDate(дата) Then НовоеИмяФайла = Предприятие & " " & НовоеИмяФайла & _
       " " & LCase(Format(дата, "MMMM YYYY"))

столкнулся с тем, что не все ковычки заменяются если их больше 2-х

[The_Prist]

Сообщение от xamillion

столкнулся с тем, что не все ковычки заменяются если их больше 2-х

Предприятие = Replace([a4], Chr(34), "'")

[xamillion]

спасибо - помогло

[AChrist]

Добры, у меня похожа проблема. у меня есть в колонке скажем A:A гиперссылки на файлы которые у меня на компе. Можно переделать макрос этот, чтоб он переименовывал сами файлы на компе исходя из данных в колонке B, C, D скажем и менял гиперссылку на переименованный файл.

Пример:
A1 = D:\image0011.jpg, B1 = 1, C1 = 1, D1 = 1 ---> A1 = D:\1_1_1.jpg
A2 = D:\image0084.jpg, B2 = 1, C2 = 1, D2 = 2 ---> A2 = D:\1_1_2.jpg
и так далее.

[EducatedFool]

Можно переделать макрос этот, чтоб он переименовывал сами файлы на компе исходя из данных в колонке B, C, D скажем и менял гиперссылку на переименованный файл.

Да, можно.
Прикрепите к сообщению архив с файлом Excel и папкой с картинками.

A1 = D:\image0011.jpg

На момент запуска все эти файлы jpg будут существовать?
Что делать, если файл не найден?
Что делать, если нет доступа к файлу? (он открыт другой прогой, например, и переименовать его невозможно)
Файлы всегда будут располагаться в корне диска?

[AChrist]

На момент запуска все эти файлы jpg будут существовать?

Да.

Что делать, если файл не найден?

Мало вероятно, так как сначала ссылки прописываю. Но по возможности можно будет добавить просто значение в ячейку "missing".

Что делать, если нет доступа к файлу?

Так как это действие будет выполнятся редко, думаю просто чтоб макрос выдал ошибку достаточно.

Файлы всегда будут располагаться в корне диска?

Не всегда. Путь может быть D:\Folder\subfolder\subfolder вообщем во вложенных папках.
Путь можно оставлять тот же, только переименовать файл.

[EducatedFool]

Проверяйте:

Sub test()
    On Error Resume Next
    Dim cell As Range: Application.ScreenUpdating = False
    For Each cell In Range([A2], Range("A" & Rows.Count).End(xlUp)).Cells ' перебираем ячейки в столбце А
        Путь = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, cell.Hyperlinks(1).Address)
        ИмяФайла = Left(Dir(Путь), InStrRev(Dir(Путь), ".") - 1) ' имя без расширения
        НовоеИмя = cell(1, 2) & "_" & cell(1, 3) & "_" & cell(1, 4) ' имя из ячеек
        cell.Hyperlinks(1).Address = Replace(Dir(Путь), ИмяФайла, НовоеИмя) ' меняем гиперссылку
        Name Путь As Replace(Путь, ИмяФайла, НовоеИмя) ' переименование файла
    Next cell
End Sub

Обрабатываются файлы только в той папке, где расположена книга Excel

[AChrist]

спасибо, работает отлично.

Только до меня не сразу дошло когда я поменял колонку с которой надо переименовывать, что значения для ячеек такие же надо было оставить. Для меня это было новое так как не знаком с тем что "Range" так работает.

[xamillion]

теперь появилась необходимость не только переименовывать, а и удалять файлики по условию если пустая ячейка...

[The_Prist]

if cell = "" then Kill  Путь

Только вопрос: а откуда брать путь к файлу, если ячейка пустая?