oldName = Cells(i, 1).Value & ".xlsx"

oldName = Dir(folderPath & Cells(i, 1).Value & ".xls*")

Option Explicit

Sub RenameFiles()

    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Выберите папку с файлами"

        If .Show = -1 Then
            
            Dim folderPath As String
            folderPath = .SelectedItems(1) & "\"
        Else
            MsgBox "Папка не выбрана."
            Exit Sub
        End If

    End With

    On Error GoTo CleanExit
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim i           As Long
    i = 1

    Do While Cells(i, 1).Value <> ""
        
        Dim renamedCount As Long
        Dim skippedCount As Long

        Dim oldName As String
        oldName = Trim(Cells(i, 1).Value)

        Dim newName As String
        newName = Trim(Cells(i, 2).Value)

        ' Ищем файл с любым расширением
        Dim fileFound As String
        fileFound = Dir(folderPath & oldName & ".*")

        If fileFound = "" Then
            skippedCount = skippedCount + 1
        Else

            ' Получаем расширение
            Dim fileExt As String
            fileExt = Mid(fileFound, InStrRev(fileFound, "."))

            Dim fullOldPath As String
            fullOldPath = folderPath & fileFound

            Dim fullNewPath As String
            fullNewPath = folderPath & newName & fileExt

            ' Проверка — существует ли файл с новым именем
            If Dir(fullNewPath) <> "" Then
                skippedCount = skippedCount + 1
            Else
                Name fullOldPath As fullNewPath
                renamedCount = renamedCount + 1
            End If

        End If

        i = i + 1

    Loop

CleanExit:
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    If Err.Number <> 0 Then
        MsgBox "Ошибка: " & Err.Description, vbCritical
    Else
        MsgBox "Готово!" & vbCrLf & _
                "Переименовано: " & renamedCount & vbCrLf & _
                "Пропущено: " & skippedCount, _
                vbInformation
    End If

End Sub