VBA - skip corrupted files-CodePudding

Im new on VBA thing, today I copied a code from another forum that opens every excel that I have on a path and sets the password to ""; it ocurrs that i have a 480 excels on that paths, and the code stops whenever encounters a corrupted file... Wanted to know if:

There is a way to encounter every file on that path that is corrupted with some sort of code.
If there is a way i can code this code, to avoid corrupted files whenever it encounters a corrupted file

The code is the following one.

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, just stops and doesnt let me know which file is the one that is corrupted...

Im very new at this, i know that there is a way to put a "if" formula in there to skip this errors, but dont know how to do it :(

Appreciate your help a lot! thanks!

CodePudding user response：

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

CodePudding user response：

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