运行 VBA 脚本导致 excel 停止响应
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/18144312/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Running VBA script causes excel to stop responding
提问by Saint
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
回答by Kazimierz Jawor
So, some tips for you:
所以，给你一些提示：
1st. (according to comment)
第一。（根据评论）
Add as a first line to your sub: Application.ScreenUpdating = falseand 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):
第二。移动这一行（它正在设置常量引用）：
Set wb = Workbooks("Equipment Further Documentation List.xls")
before:
前：
Do Until txtStream.AtEndOfStream
3rd is just a tip.
3rd只是一个提示。
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 Subadd 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 个文件必须非常耗时。
回答by Saint
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.
非常感谢。
