excel - 使用 VBA 打开和修复多个 excel 文件

Question

几年来我一直在使用 Google 表格，并在 Microsoft Excel 中制作报告。我每周处理近 50 多张表格，我将数据一张一张地复制并粘贴到 Excel 中以保持单元格格式。

我试图下载包含 Google 表格的整个文件夹，然后在 Microsoft Excel 中打开它，这在打开每个文件时都出现错误:

[![在此处输入图片描述][1]][1]

一旦我单击“确定”，它就会填充另一个错误:

[![![在此处输入图片描述][2]][2]

我正在寻找一种方法来修复此错误，而不是单独打开每个文件然后保存它以使其修复(这样错误就不会再次出现)。

我试过下面的代码，但它不起作用，我不知道为什么。我需要在整个文件夹上应用此方法来修复所有 Excel 文件并保存它们。

非常感谢您的帮助

    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


  [1]: /image/ofXMK.png
  [2]: /image/PlHxX.png

Answer 1

请测试下一个代码。它将在要处理的选定文件夹中创建一个子文件夹“RecoveredWB”，所有处理过的文件都将保存在该文件夹中:

Sub Folder()
    Dim strFolder As String, strFile As String, wbk As Workbook
    Dim wsh As Worksheet, 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
    
    Dim wbName As String, arrWb, subFoldNew As String
    subFoldNew = strFolder & "RecoveredWB"
     'create RecoveredWB folder if not existing:
      If Dir(subFoldNew, vbDirectory) = "" Then MkDir subFoldNew
      
    Application.ScreenUpdating = False
    strFile = Dir(strFolder & "*.xlsx")
    Do While strFile <> ""
      Set wbk = Workbooks.Open(strFolder & strFile, CorruptLoad:=xlRepairFile)
      For Each wsh In wbk.Worksheets
      Next wsh
      
      arrWb = Split(wbk.fullname, "\") 'place the full name in an array split by "\"
      wbName = arrWb(UBound(arrWb)) 'the workbook name (without path)
      
      wbk.SaveCopyAs subFoldNew & "\" & wbName
      
      wbk.Close False
      
      strFile = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

代码未经测试，我无法重现这种情况，没有损坏的工作簿...

如果出现问题，请解释在哪一行代码中出现的错误，或者它不应该发生的事情。