VBA Rename File сохраняет неправильный тип файла

Question

Этот сценарий должен go в папку, полную файлов Excel, переименовать файлы по имени автора и счетчику и сохранить их в новой папке.

Однако теперь файл не сохраняется. как документ Excel, но тип файла также является именем автора и количеством.

Я отредактировал код из предложенных комментариев, но теперь я получаю эту ошибку:

Ошибка выполнения

Я неправильно отредактировал код?

    Sub RenameExcelFilesbyAuthor()


Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim Counter As Integer

'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Application.CalculateBeforeSave = False
Application.AskToUpdateLinks = False
'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

With FldrPicker
.Title = "C:\Users\Name\Documents\Excel Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With

'In Case of Cancel
NextCode:
 myPath = myPath
 If myPath = "" Then GoTo ResetSettings
 
 'Target File Extension (must include wildcard "*")
 myExtension = "*.xlsx*"
 
 'Target Path with Ending Extention
 myFile = Dir(myPath & myExtension)
 
 Counter = 1
 
 'Loop through each Excel file in folder
 Do While myFile <> ""
  'ReadOnly = False
    Set wb = Nothing
    On Error Resume Next
    'Set variable equal to opened workbook
     Set wb = Workbooks.Open(Filename:=myPath & myFile)
    On Error GoTo 0
    If wb Is Nothing Then
        On Error Resume Next
        wb.Close
    Else
    Counter = Counter + 1
    'Ensure Workbook has opened before moving on to next line of code
     DoEvents

   'Change First Worksheet's Background Fill Blue
   ThisWorkbook.BuiltinDocumentProperties("Author") = Author
     wb.SaveAs Filename:="C:\Users\max\Documents\New folder\" & wb.BuiltinDocumentProperties("Author") & Counter & myExtension, FileFormat:=xlWorkbookDefault
   
   'Save and Close Workbook
     wb.Close SaveChanges:=True
     
   'Ensure Workbook has closed before moving on to next line of code
     DoEvents
    End If
   
   'Get next file name
     myFile = Dir
     
 Loop
 
 'Message Box when tasks are completed
 MsgBox "Task Complete!"
 
ResetSettings:
 'Reset Macro Optimization Settings
   Application.EnableEvents = True
   Application.Calculation = xlCalculationAutomatic
   Application.ScreenUpdating = True
   Application.DisplayAlerts = True
End Sub


  [1]: https://i.stack.imgur.com/XVPT1.png