VBA -跳过损坏的文件

Question

我从另一个网站复制了代码，该网站打开路径上的每个Excel文件并将密码设置为"

我在该路径上有480个Excel文件，每当遇到损坏的文件时，代码就会停止。

• 是否有一种方法来识别每个损坏的文件?
是否有一种方法来避免损坏的文件?

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

另一方面，当代码遇到一个损坏的文件时，它只是停止并且不让我知道哪个文件损坏了。

我知道有一种方法可以使用"if"我想跳过这个错误，但是我不知道怎么做。

Answer 1

请尝试下一个改编代码:

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

我会稍微修改一下FaneDuru建议的代码，以符合您的第一个要求。此代码将在调试面板中输出损坏的文件名。

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