Подготовьте таблицу: в столбце A — полный путь старого файла, в B — новое имя с расширением. Макрос ниже не перезаписывает существующие файлы и записывает результат в C.
Рабочий макрос
Option Explicit
Sub RenameFilesFromList()
Dim ws As Worksheet, lastRow As Long, r As Long
Dim oldPath As String, newName As String, folder As String, newPath As String
Set ws = ThisWorkbook.Worksheets("Переименование")
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
For r = 2 To lastRow
oldPath = Trim$(CStr(ws.Cells(r, "A").Value))
newName = Trim$(CStr(ws.Cells(r, "B").Value))
ws.Cells(r, "C").Value = ""
If oldPath = "" Or newName = "" Then
ws.Cells(r, "C").Value = "Пропущено: нет пути или имени"
ElseIf Dir$(oldPath) = "" Then
ws.Cells(r, "C").Value = "Исходный файл не найден"
ElseIf InStr(newName, "\") > 0 Or InStr(newName, "/") > 0 Then
ws.Cells(r, "C").Value = "В новом имени указан путь"
Else
folder = Left$(oldPath, InStrRev(oldPath, "\"))
newPath = folder & newName
If StrComp(oldPath, newPath, vbTextCompare) = 0 Then
ws.Cells(r, "C").Value = "Имя не изменилось"
ElseIf Dir$(newPath) <> "" Then
ws.Cells(r, "C").Value = "Файл с новым именем уже есть"
Else
Name oldPath As newPath
ws.Cells(r, "C").Value = "Готово"
End If
End If
Next r
End Sub
Как запустить
Создайте лист Переименование, вставьте заголовки в A1:C1 и заполните список. Сохраните книгу как XLSM, откройте редактор Alt+F11, добавьте обычный модуль и вставьте код.
Ограничения имён
Windows не разрешает символы \ / : * ? " < > |. В новом имени обязательно сохраняйте расширение, например .pdf. Закрытые другими программами файлы могут не переименоваться.
Безопасная проверка
Сначала скопируйте 2–3 файла в тестовую папку и выполните макрос на копиях. Для массовой обработки добавьте журнал старых и новых путей — он позволит выполнить обратное переименование.
Когда нужна доработка
Для нумерации, очистки запрещённых символов, обхода подпапок и отката лучше сделать отдельный сценарий с предварительным просмотром изменений.