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

Question

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

excelvba

3

多年来，我一直在使用Google Sheets并在Microsoft Excel中制作报告。每周我都要处理50多个工作表，需要逐一复制和粘贴数据以保留单元格格式。

我曾尝试下载包含Google Sheets的整个文件夹，然后在Microsoft Excel中打开它，但是每次打开文件时都会出现以下错误：

[![enter image description here][1]][1]

点击“确定”后，就会弹出另一个错误，如下：

[![![enter image description here][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]: https://istack.dev59.com/ofXMK.webp
  [2]: https://istack.dev59.com/PlHxX.webp

- HSHO

2

“不工作”的具体位置在哪里？在您的while循环中，有一个“Exit Sub”，并且您还循环遍历工作表而没有在那里执行任何操作？ - Notus_Panda

2

请使用CorruptLoad：=xlRepairFile代替CorruptLoad：=XlCorruptLoad.xlRepairFile，并注释下一行代码：Exit Sub，Err_Open:，Err.Clear。这三行只有在避免可能出现的错误时才有意义，但要使用它们，您必须在相应的循环之前使用On Error Goto Err_Open，并且将相应的代码行移到循环之外。在工作表之间进行无用迭代似乎毫无意义，但这不会影响代码的工作逻辑... - FaneDuru

然后，尝试将保存代码行(wbk.Close SaveChanges:=True)放置在下面两个代码行之间：Application.DisplayAlerts = False和Application.DisplayAlerts = True。如果不起作用（可能是因为Excel想要将其保存在不同的位置），您应该使用类似于：wbk.SaveCopyAs FilePath & "\" & FileName的东西。其中FilePath应定义为不同的文件夹，而FileName应从现有文件中提取。接着是wbk.Close False...使用SaveCopyAs时，这不会更改内存中的wbk。 - FaneDuru

如果不介意的话，您能否发布一个答案呢？我真的很感激您的帮助。 - HSHO

@HSHO 好的，我会回答，但现在不是时候... - FaneDuru

显示剩余4条评论

1个回答

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- FaneDuru · Accepted Answer

请测试下面的代码。它将在选定的文件夹中创建一个名为“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

这段代码没有经过测试，我无法重现情况，因为没有受损的工作簿...

如果出现问题，请解释哪个代码行上出现了什么错误，或者它没有达到应该有的效果。