VBA - Skip corrupted files - excel

Question

I copied code from another site that opens every Excel file on a path and sets the password to "".
I have 480 Excel files on that path, and the code stops whenever it encounters a corrupted file.
Is there a way to identify every file that is corrupted?
Is there a way to avoid corrupted files?
Sub RemovePasswords()
Dim xlBook As Workbook
Dim strFilename As String
Const fPath As String = "C:\Path\" 'The folder to process, must end with "\"
Const strPassword As String = "openpassword" 'case sensitive
Const strEditPassword As String = "editpassword" 'If no password use ""
strFilename = Dir$(fPath & "*.xls") 'will open xls & xlsx etc
While Len(strFilename) <> 0
Application.DisplayAlerts = False
Set xlBook = Workbooks.Open(FileName:=fPath & strFilename, _
Password:=strPassword, _
WriteResPassword:=strEditPassword)
xlBook.SaveAs FileName:=fPath & strFilename, _
Password:="", _
WriteResPassword:="", _
CreateBackup:=True
xlBook.Close 0
Application.DisplayAlerts = True
strFilename = Dir$()
Wend
End Sub
On the other hand, whenever the code encounters a corrupted file it just stops and doesn't let me know which file is corrupted.
I know that there is a way to put a "if" to skip this errors, but I don't know how to do it.

Answer 1

Please, try the next adapted code:
Sub RemovePasswords()
Dim xlBook As Workbook, strFilename As String
Const fPath As String = "C:\Path\" 'The folder to process, must end with "\"
Const strPassword As String = "openpassword" 'case sensitive
Const strEditPassword As String = "editpassword" 'If no password use ""
strFilename = dir$(fPath & "*.xls") 'will open xls & xlsx etc
While Len(strFilename) <> 0
On Error Resume Next 'skip the error, if the case
Set xlBook = Workbooks.Open(fileName:=fPath & strFilename, _
password:=strPassword, _
WriteResPassword:=strEditPassword)
If err.Number = 0 Then 'if no error:
Application.DisplayAlerts = False
xlBook.saveas fileName:=fPath & strFilename, _
password:="", _
WriteResPassword:="", _
CreateBackup:=True
xlBook.Close 0
Application.DisplayAlerts = True
End If
On Error GoTo 0 'restart raising errors when the case
strFilename = dir$()
Wend
End Sub

Answer 2

I would change the code suggested by FaneDuru a little, in order to comply to your first demand. This code will output corrupt filenames in the debug panel.
Sub RemovePasswords()
Dim xlBook As Workbook
Dim strFilename As String
Const fPath As String = "C:\Path\" 'The folder to process, must end with "\"
Const strPassword As String = "openpassword" 'case sensitive
Const strEditPassword As String = "editpassword" 'If no password use ""
strFilename = Dir$(fPath & "*.xls") 'will open xls & xlsx etc
Application.DisplayAlerts = False
On Error Resume Next
While Len(strFilename) <> 0
Set xlBook = Workbooks.Open(FileName:=fPath & strFilename, _
Password:=strPassword, WriteResPassword:=strEditPassword)
If err.Number = 0 Then
xlBook.SaveAs FileName:=fPath & strFilename, _
Password:="", WriteResPassword:="", CreateBackup:=True
xlBook.Close 0
Else
Debug.Print strFilename 'This will output corrupt filenames in the debug pane
err.Clear
End If
strFilename = Dir$()
Wend
On Error GoTo 0
Application.DisplayAlerts = True
End Sub