Excel VBA重命名文件夹中已损坏文件的工作簿

我想以作者的名字重命名大约2000本工作簿&一个计数器。 一些工作簿已损坏，但打开时会产生错误

当不可避免地出现错误时，我如何编辑代码来避免这种情况

另外，我可以以读/写方式打开工作簿吗？ 代码出错，不让我保存，因为它说文件是只读的

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

'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

With FldrPicker
.Title = "C:\Users\Logan\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 = "*.xlxs*"

 '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
        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
     wb.Name = ThisWorkbook.BuiltinDocumentProperties("Last Author") & Counter

   '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

End Sub

子重命名Excelfilesbyauther（）
将wb设置为工作簿
将myPath设置为字符串
将myFile设置为字符串
Dim myExtension作为字符串
Dim FldrPicker As FILE对话框
作为整数的Dim计数器
'优化宏速度
Application.ScreenUpdating=False
Application.EnableEvents=False
Application.Calculation=xlCalculationManual
'从用户检索目标文件夹路径
Set FldrPicker=Application.FileDialog（msoFileDialogFolderPicker）
用FldrPicker
.Title=“C:\Users\Logan\Documents\Excel文件夹”
.AllowMultiSelect=False
如果.Show-1，则转到下一个代码
myPath=.SelectedItems（1）和“\”
以
"如果取消,
'下一个代码：
myPath=myPath
如果myPath=”“，则转到重置设置
'目标文件扩展名（必须包含通配符“*”）
myExtension=“*.xlxs*”
'具有结束扩展名的目标路径
myFile=Dir（myPath&myExtension）
计数器=1
'循环浏览文件夹中的每个Excel文件
当我的文件“”时执行此操作
只读=假
设置wb=Nothing
出错时继续下一步
'将变量设置为等于打开的工作簿
设置wb=Workbooks.Open（文件名：=myPath&myFile）
错误转到0
如果wb不算什么，那么
wb.关闭
其他的
计数器=计数器+1
'在继续下一行代码之前，确保工作簿已打开
多芬特
'更改第一个工作表的背景填充为蓝色
wb.Name=ThisWorkbook.BuiltinoDocumentProperties（“最后作者”）&计数器
'保存并关闭工作簿
wb.Close SaveChanges:=真
'在继续下一行代码之前，确保工作簿已关闭
多芬特
如果结束
'获取下一个文件名
myFile=Dir
环
'任务完成时的消息框
MsgBox“任务完成！”
'重置设置：
'重置宏优化设置
Application.EnableEvents=True
Application.Calculation=xlCalculationAutomatic
Application.ScreenUpdating=True
端接头

将循环更改为a for each（必须使用文件系统对象初始化myFiles），然后执行类似操作

For Each oFile In myFiles
     On Error GoTo NextFile

    'your code

NextFile:
    Resume NextFile2
NextFile2:
    Next oFile

---

当发生错误时，它将使用NextFile2恢复。错误将被清除，循环将继续。

在处理特定错误时，应尽可能将错误处理程序紧紧地包裹在潜在错误周围。这样，其他错误仍然会暴露出来。请注意，文件可能无法打开的原因不止一个

差不多

myFile = Dir(myPath & myExtension)
Counter = 0

'Loop through each Excel file in folder
Do While myFile <> ""
    Set wb = Nothing
    On Error Resume Next
        Set wb = Workbooks.Open(Filename:=myPath & myFile)
    On Error GoTo 0
    If wb Is Nothing Then
        ' there was an error
    Else
        Counter = Counter + 1

        'Your code here
    End If

    'Get next file name
    myFile = Dir
Loop

myFile=Dir（myPath&myExtension）
计数器=0
'循环浏览文件夹中的每个Excel文件
当我的文件“”时执行此操作
设置wb=Nothing
出错时继续下一步
设置wb=Workbooks.Open（文件名：=myPath&myFile）
错误转到0
如果wb不算什么，那么
“有一个错误
其他的
计数器=计数器+1
'您的代码在这里
如果结束
'获取下一个文件名
myFile=Dir
环

我不知道如何将其添加到while循环中，也不知道如何在excel表示其已损坏时关闭错误消息谢谢您的回复。我编辑代码以反映这些更改。看起来对吗？另外，是否有一种方法可以在我的代码出错时以读/写方式打开工作簿，因为它说工作簿是只读的。