运行VBA脚本导致Excel停止响应

Question

我有一个VBA脚本，可以将sheet添加到大约500个Excel文件中。我在运行VBA脚本并添加简单的sheet时没有任何问题，但是当我尝试添加包含VBA脚本、图表和按钮的sheet时，它会运行一段时间然后冻结。

以下是代码。我知道它没有错误处理-有什么建议如何解决这个问题或者可能导致Excel冻结的原因吗？

Sub FindOpenFiles()

Const ForReading = 1
Set oFSO = New FileSystemObject

Dim txtStream As TextStream

Dim FSO As Scripting.FileSystemObject, folder As Scripting.folder, file As Scripting.file, wb As Workbook, sh As Worksheet
Dim directory As String

'The path for the equipement list. - add the desired path for all equipement or desired value stream only.
Set txtStream = oFSO.OpenTextFile("O:\SiteServices\Maintenance\Maintenance Support Folder\Maintenance Department Information\HTML for Knowledgebase\Excel for Knowledgebase\Equipement paths-all.txt", ForReading)

Do Until txtStream.AtEndOfStream
    strNextLine = txtStream.ReadLine
    If strNextLine <> "" Then

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set folder = FSO.GetFolder(strNextLine)


    For Each file In folder.Files
        If Mid(file.Name, InStrRev(file.Name, ".") + 1) = "xls" Then
            Workbooks.Open strNextLine & Application.PathSeparator & file.Name

        Set wb = Workbooks("Equipment Further Documentation List.xls")
    For Each sh In Workbooks("Master File.xls").Worksheets
        sh.Copy After:=wb.Sheets(wb.Sheets.Count)
    Next sh

     ActiveWorkbook.Close SaveChanges:=True
     ActiveWorkbook.CheckCompatibility = False

        End If


    Next file
    End If

    Loop
txtStream.Close

End Sub

- Saint

---

在你的子程序第一行添加如下代码：Application.ScreenUpdating = false，并在 End Sub 之前添加另一行代码：Application.ScreenUpdating = true。 - Kazimierz Jawor

@KazJaw - 我已经添加了这些代码行，运行了程序，但仍然是同样的问题... - Saint

我认为它不会崩溃，但由于您的子程序耗时较长，它会冻结。请尝试我的答案中的三个建议，并在有任何变化时提供反馈。 - Kazimierz Jawor

@Saint 为什么你看不到是哪一行导致了崩溃？这是完全的 Excel 崩溃还是只是代码错误（例如，弹出错误消息框）？我能看到的一个问题是你假设每个文件夹中的任何 xls 文件都叫做“Equipment Further Documentation List.xls”。 - Cor_Blimey

与您的问题无关，但您可以使用GetExtensionName方法而不是Mid(file.Name, InStrRev(file.Name, ".") + 1) = "xls"。如果您愿意，您可以将其更改为FSO.GetExtensionName(file.Name) = "xls"。在我看来，这样会更加简洁。 - UberNubIsTrue

Answer 1

以下是一些提示：

第一条（根据评论）：

在你的子程序中添加以下代码作为第一行：Application.ScreenUpdating = false，并将另一行代码添加到 End Sub 前面：Application.ScreenUpdating = true。

第二条：移动此行（它设置了常量引用）：

Set wb = Workbooks("Equipment Further Documentation List.xls")

之前:

Do Until txtStream.AtEndOfStream

第三个只是一个提示。

要查看您的子进度，请添加以下行：

Application.StatusBar = file.Name

在此行后面：

Workbooks.Open strNextLine & Application.PathSeparator & file.Name

在 End Sub 之前，另外添加以下代码：

Application.StatusBar = false

因此，您可以在Excel应用程序中的状态栏中看到当前正在处理的文件名。

请记住，处理500个文件可能需要很长时间。

- Kazimierz Jawor

---

第三点很重要-它会让您知道您的子程序是否在运行。 - Kazimierz Jawor

在每个循环前加入DoEvents。这将确保Excel继续刷新并保持相对响应。 - Cor_Blimey

@KazJaw - 当Excel冻结时，宏无法运行，我检查了工作表是否已添加到Excel文件中，但不幸的是没有。我将尝试缩短列表，只保留10个左右，并使用Stop方法... - Saint

@KazJaw 尝试了 stop 方法，但仍然是同样的问题... 将该表格添加到 3 个文件中，宏再次冻结... 我将尝试重写宏，或者在不同的电脑上运行它，或者其他方法。 - Saint

如果目标工作簿已经包含了一个同名的表格，那么这个操作将会失败。尝试使用worksheet.Move方法，它更加可靠（虽然在表格示例中仍可能失败）。您可以随时在不保存的情况下关闭源工作簿，然后重新打开它。 - Cor_Blimey

Answer 2

我终于解决了我的问题...

解决方法是添加一行代码：

Application.Wait (Now + TimeValue("0:00:01"))

在这行后面：

sh.Copy After:=wb.Sheets(wb.Sheets.Count)

这样可以有足够的时间将表格复制到新的Excel文件中。

到目前为止，一切运作得非常顺利。

我想感谢每个帮助我解决此问题的人。

非常感谢。

- Saint