VBA для переименования книг в папке с поврежденными файлами

Question

Я хочу переименовать около 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

Answer 1

При обработке определенных c ошибок вы должны как можно плотнее обернуть обработчик ошибок вокруг потенциальной ошибки. Таким образом, будут обнаружены другие ошибки. Обратите внимание, что есть несколько причин, по которым файл может не открываться.

Примерно

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

Answer 2

Измените l oop на a для каждого (вам нужно будет инициализировать myFiles с помощью объекта FileSystem) и сделать что-то вроде этого.

For Each oFile In myFiles
     On Error GoTo NextFile

    'your code

NextFile:
    Resume NextFile2
NextFile2:
    Next oFile

При возникновении ошибки он возобновится с NextFile2 ошибка будет удалена, и l oop продолжится.