使用VBA批量打开并修复多个Excel文件问题求助

我用Google Sheets制作Excel报表，每周要处理50+表格。为保留单元格格式，之前只能逐个复制粘贴数据。尝试下载整个Google Sheets文件夹后用Excel打开时，每个文件都会报错，点确定还会弹出第二个错误。不想逐个打开保存修复，想用VBA批量处理，以下是我写的代码，求解决：

Sub Folder()
Dim strFolder As String
Dim strFile As String
Dim wbk As Workbook
Dim wsh As Worksheet
Dim I As Long

With Application.FileDialog(4)
    If .Show Then
        strFolder = .SelectedItems(1)
    Else
        MsgBox "You haven't selected a folder!", vbExclamation
        Exit Sub
    End If
End With
If Right(strFolder, 1) <> "\" Then
    strFolder = strFolder & "\" 
End If

Application.ScreenUpdating = False
strFile = Dir(strFolder & "*.xlsx*")
Do While strFile <> ""
    Set wbk = Workbooks.Open(strFolder & strFile, CorruptLoad:=XlCorruptLoad.xlRepairFile)
    For Each wsh In wbk.Worksheets
    Next wsh
    wbk.Close SaveChanges:=True
    strFile = Dir

    Exit Sub
Err_Open:
    Err.Clear
Loop

Application.ScreenUpdating = True
End Sub

修复后的代码 #

Sub BatchRepairExcelFiles()
    Dim strFolder As String
    Dim strFile As String
    Dim wbk As Workbook
    
    '选择目标文件夹
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then
            strFolder = .SelectedItems(1)
        Else
            MsgBox "未选择文件夹！", vbExclamation
            Exit Sub
        End If
    End With
    '确保文件夹路径末尾带斜杠
    If Right(strFolder, 1) <> "\" Then
        strFolder = strFolder & "\"
    End If
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False '关闭保存时的弹窗提示
    
    strFile = Dir(strFolder & "*.xlsx") '只处理xlsx格式，避免匹配无关文件
    Do While strFile <> ""
        On Error Resume Next '启用错误处理
        '尝试修复打开文件
        Set wbk = Workbooks.Open(strFolder & strFile, CorruptLoad:=xlRepairFile)
        If Err.Number = 0 Then '打开成功
            wbk.Save '保存修复后的文件
            wbk.Close False
        Else '打开失败，记录错误并跳过
            Debug.Print "处理失败：" & strFile & " 错误代码：" & Err.Number
            Err.Clear
        End If
        On Error GoTo 0 '关闭错误处理
        strFile = Dir '获取下一个文件
    Loop
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "批量修复完成！", vbInformation
End Sub

关键修复说明 #

• 移除错误的Exit Sub：原代码处理第一个文件后直接退出循环，导致仅处理单个文件，删除该语句后可遍历所有目标文件。
• 优化错误处理逻辑：添加错误捕获机制，单个文件处理失败时不会中断整个批量任务，同时在调试窗口记录失败文件信息。
• 精准匹配文件格式：将*.xlsx*改为*.xlsx，避免匹配到xlsx格式的压缩包等无关文件。
• 关闭冗余弹窗：禁用保存时的确认提示，让批量处理全程自动完成。
• 清理无效代码：删除无意义的工作表遍历循环，无需操作工作表即可完成修复保存。

内容的提问来源于stack exchange，提问作者HSHO