VBA 文件无法打开

Question

我有一个汇总文件，可以打开多个 Excel 工作簿并将其中的数据复制到主文件中。该程序几个月来一直运行良好，但在过去的几天里，它在打开某些文件时失败了。我收到以下错误消息。

运行时错误“1004”：

Excel 无法打开文件“filename.xlsm”，因为文件格式或文件扩展名无效。验证文件未损坏，文件扩展名与文件格式匹配未损坏，文件扩展名与文件格式匹配。

如果我点击调试并继续运行程序，则文件将毫无问题地打开。如果我重新启动程序，它仍然无法打开文件，但它永远不会是相同的文件。当我进入它们并且文件扩展名正确时，我找不到失败的工作簿的任何问题。我有错误处理来检查当前是否有任何人在工作簿中，所以我认为不可能。

任何帮助将不胜感激， 谢谢。

    If Not FileLocked(CStr(FoundFiles(iIndex))) Then
    On Error GoTo contentErr
    Workbooks.Open FoundFiles(iIndex) ', UpdateLinks:=xlUpdateLinksNever
    On Error GoTo 0
    Application.Run ("'Auto Update Roll-Up.xlsm'!Update")
    With Workbooks(tempvar(iIndex - 1))
        .Close False
        LogInformation ("Completed " & tempvar(iIndex - 1) & " at " & Now)
        'Application.EnableEvents = False
        '.Close True
        'Application.EnableEvents = True
    End With
End If
Continue:
Next iIndex
On Error Resume Next
DisplayAlerts = False
Workbooks("Brickman Roll-Up Template.xlsm").Close savechanges:=True
'Workbooks("Brickman Roll-Up Template Test.xlsm").Close savechanges:=True
SetAttr rollupPath, vbReadOnly
Workbooks("Auto Update Roll-Up.xlsm").Close savechanges:=False
DisplayAlerts = True
LogInformation ("Program ended at " & Now)
Application.Quit

contentErr:
If Err.Number = 1004 Then
    LogInformation ("_______There is unreadable content in " & Chr(34) & tempvar(iIndex        - 1) & Chr(34) & "_______")
    GoTo Continue
End If
End Sub



Function FileLocked(strFileName As String) As Boolean
On Error Resume Next
' If the file is already opened by another process,
' and the specified type of access is not allowed,
' the Open operation fails and an error occurs.
Open strFileName For Binary Access Read Write Lock Read Write As #1
Close #1
' If an error occurs, the document is currently open.
If Err.Number <> 0 Then
  ' Display the error number and description.
  LogInformation ("Couldn't open " & strFileName & " because it is already checked   out.")
  FileLocked = True
  Err.Clear
End If
End Function

错误发生在 Workbooks.Open FoundFiles(iIndex) 行

Answer 1

当您为工作簿指定一个已定义的名称，然后在没有先保存并关闭工作簿的情况下多次复制工作表时，可能会出现此问题，如以下示例代码所示：

Sub CopySheetTest()
    Dim iTemp As Integer
    Dim oBook As Workbook
    Dim iCounter As Integer

    ' Create a new blank workbook:
    iTemp = Application.SheetsInNewWorkbook
    Application.SheetsInNewWorkbook = 1
    Set oBook = Application.Workbooks.Add
    Application.SheetsInNewWorkbook = iTemp

    ' Add a defined name to the workbook
    ' that RefersTo a range:
    oBook.Names.Add Name:="tempRange", _
        RefersTo:="=Sheet1!$A$1"

    ' Save the workbook:
    oBook.SaveAs "c:\test2.xls"

    ' Copy the sheet in a loop. Eventually,
    ' you get error 1004: Copy Method of
    ' Worksheet class failed.
    For iCounter = 1 To 275
        oBook.Worksheets(1).Copy After:=oBook.Worksheets(1)        
    Next
End Sub

要解决此问题，请在复制过程中定期保存并关闭工作簿，如以下示例代码所示：

子 CopySheetTest() 将 iTemp 调暗为整数 将 oBook 变暗为工作簿 将 iCounter 调暗为整数

' Create a new blank workbook:
iTemp = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Set oBook = Application.Workbooks.Add
Application.SheetsInNewWorkbook = iTemp

' Add a defined name to the workbook
' that RefersTo a range:
oBook.Names.Add Name:="tempRange", _
    RefersTo:="=Sheet1!$A$1"

' Save the workbook:
oBook.SaveAs "c:\test2.xls"

' Copy the sheet in a loop. Eventually,
' you get error 1004: Copy Method of
' Worksheet class failed.
For iCounter = 1 To 275
    oBook.Worksheets(1).Copy After:=oBook.Worksheets(1)
    'Uncomment this code for the workaround:
    'Save, close, and reopen after every 100 iterations:
    If iCounter Mod 100 = 0 Then
        oBook.Close SaveChanges:=True
        Set oBook = Nothing
        Set oBook = Application.Workbooks.Open("c:\test2.xls")
    End If
Next End Sub

来源 - “MSDN”

Answer 2

如果您澄清和/或发布更多代码，您可能会得到更好的帮助。具体来说：1）您是否在主程序中的Workbooks.Open 或FileLocked 函数中的Open 上遇到错误？ 2）FoundFiles()（用于打开）和tempvar()（用于关闭）之间的关系是什么？你是如何设置这些数组/变量的？

如果没有这些信息，我最好的建议是：在 iIndex 循环中使用 Workbook 变量。所以，在你的循环之前添加

Dim wbLoop as Workbook

然后代替

Workbooks.Open FoundFiles(iIndex)

使用

Set wbLoop = Workbooks.Open(FoundFiles(iIndex))

而不是

With Workbooks(tempvar(iIndex - 1))

使用

With wbLoop

在关闭 If 块之前，添加

Set wbLoop = Nothing