Переименование подпапок в папке с помощью Excel VBA

Question

Я пытаюсь переименовать все подпапки в определенной папке (C: Users \ admin \ Documents \ AWS).В столбце AI есть старые имена папок, которые должны быть заменены соответствующими новыми именами в B.

Это код, который я пробовал (набранный в Sheet17 в редакторе Visual Basic).Sheet17 - это электронная таблица в рабочей тетради с двумя столбцами текста.Все подпапки находятся в папке AWS.

Sub rename_folder()
    Const FILEPATH As String = "C:Users\admin\Documents\AWS\"
    Dim strfile As String
    Dim filenum As String
    strfile = Dir(FILEPATH)

    Dim old_name, new_name As String

    For i = 2 To Sheets(17).Range("a1").End(xlDown).Row
        strOldDirName = FILEPATH & Sheets(17).Cells(i, 1).Value
        strNewDirName = FILEPATH & Sheets(17).Cells(i, 2).Value
        Name strOldDirName As strNewDirName
    Next i

    MsgBox "Congratulations! You have successfully renamed all the Folders"
End Sub

Я получил

Ошибка времени выполнения '53': файл не найден

при запуске кода.Не удалось найти окно отладки (я на Mac, использую Microsoft 2017), но, вероятно, это одна из первых строк кода.Пожалуйста, дайте мне знать, если какие-либо из последующих строк также должны быть изменены.

Answer 1

Для меня это работало нормально.

Sub rename_folder()
Const FILEPATH As String = "C:\Users\Excel\Desktop\test\"
Dim strfile As String
Dim filenum As String
strfile = Dir(FILEPATH)

Dim old_name, new_name As String
For i = 2 To Sheets(1).Range("a2").End(xlDown).Row
    strOldDirName = FILEPATH & Sheets(1).Cells(i, 1).Value
    strNewDirName = FILEPATH & Sheets(1).Cells(i, 2).Value
    Name strOldDirName As strNewDirName
Next i
MsgBox "Congratulations! You have successfully renamed all the Folders"
End Sub

До:

После:

Answer 2

Может быть

Const FILEPATH As String = "C:\Users\admin\Documents\AWS\"

вместо

Const FILEPATH As String = "C:Users\admin\Documents\AWS\"

причина отсутствия \ после буквы диска