VBA-跳過損壞的檔案

我從另一個站點復制了代碼，該站點打開路徑上的每個 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

另一方面，每當代碼遇到損壞的檔案時，它就會停止并且不會讓我知道哪個檔案已損壞。

我知道有一種方法可以放置“如果”來跳過此錯誤，但我不知道該怎么做。

uj5u.com熱心網友回復：

請嘗試下一個改編的代碼：

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

uj5u.com熱心網友回復：

我會稍微更改 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

標籤：擅长 vba

上一篇：對帶有空白單元格的行執行Linest函式excel

下一篇：如何在excel中添加0.12.5和0.4.18