运行VBA脚本会导致excel停止响应

I have a VBA script that adds sheets to around 500 excel files. I had no problems running the VBA script and adding simple sheets, but when I try to add a sheet with VBA script in it and graphs and buttons, it works for a while and than freezes.

我有一个VBA脚本，可以为大约500个excel文件添加工作表。我在运行VBA脚本和添加简单工作表时没有遇到任何问题，但是当我尝试在其中添加带有VBA脚本的工作表以及图形和按钮时，它会工作一段时间而不是冻结。

Here is the code. I know it does not have error handling - any suggestions how to tackle this problem or maybe what is causing excel to freeze?

这是代码。我知道它没有错误处理 - 任何建议如何解决这个问题或者是什么导致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

2 个解决方案

#1

So, some tips for you:

所以，一些提示：

1st. (according to comment)

1。（根据评论）

Add as a first line to your sub: Application.ScreenUpdating = false and add the other line right before End Sub : Application.ScreenUpdating = true

将第一行添加到sub：Application.ScreenUpdating = false并在End Sub之前添加另一行：Application.ScreenUpdating = true

2nd. Move this line (it's setting constance reference):

第2位。移动这一行（它的设置常量参考）：

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

before:

之前：

Do Until txtStream.AtEndOfStream

3rd is just a tip.

第三个只是一个提示。

To see the progress of your sub add the following line:

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

Application.StatusBar = file.Name

after this line:

在这一行之后：

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

Before the End Sub add additionally this code:

在End Sub之前添加此代码：

Application.StatusBar = false

As a result you can see in Excel app, in the status bar, file name which is currently in process.

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

Keep in mind that working with 500 files must be time-consuming.

请记住，使用500个文件必须非常耗时。

#2

I have finally solved my problem...

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

The solution was to add a line of code:

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

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

after the line:

行后：

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

which allowed time to copy the sheet to the new excel file.

这允许时间将工作表复制到新的Excel文件。

So far it has been working like a charm.

到目前为止，它一直像一个魅力。

I want to thank everyone that helped me with this issue.

我要感谢帮助我解决这个问题的每个人。

Many Thanks.

非常感谢。

#1