VBAスクリプトを実行するとExcelが応答を停止する

Question

約500個のExcelファイルにシートを追加するVBAスクリプトがあります。 VBAスクリプトを実行してシンプルなシートを追加するのに問題はありませんでしたが、VBAスクリプトとグラフとボタンを含むシートを追加しようとすると、しばらくの間、フリーズします。

ここにコードがあります。私はそれがエラー処理を持っていないことを知っています - どのようにこの問題に取り組むべきか、あるいは何が凍結するのを引き起こしているのでしょうか？

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 

Answer 1

私は最終的に

ソリューションは、コードの行を追加することでした私の問題を解決した...

：

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

時間を許可：行の後

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

をシートを新しいExcelファイルにコピーします。

これまでのところ、魅力的な働きをしています。

私はこの問題を助けてくれた皆様に感謝したいと思います。

多くのありがとうございます。

Answer 2

だから、あなたのためにいくつかのヒント：

第一。 （コメントによる）

は、あなたのサブに最初の行として追加します。Application.ScreenUpdating = falseと右End Sub前に他の行を追加します。Application.ScreenUpdating = true

第二。 （それはスタンスの参照を設定しています）この行を移動：

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

前：

Do Until txtStream.AtEndOfStream 

第三は単なるヒントです。 End Subは、さらに、このコードを追加する前に

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

：この行の後

Application.StatusBar = file.Name 

：

Application.StatusBar = false 

あなたのサブ次の行を追加の進行状況を表示するには

結果として、Excelアプリ、ステータスバー、ファイル現在処理中の名前です。

500ファイルでの作業には時間がかかることに注意してください。