2013-08-09 2 views
5

У меня есть сценарий VBA, который добавляет листы примерно к 500 файлам excel. У меня не было проблем с запуском сценария VBA и добавлением простых листов, но когда я пытаюсь добавить лист с помощью скрипта VBA в нем, а также графиков и кнопок, он работает некоторое время, а не зависает.Запуск сценария VBA приводит к тому, что excel перестает отвечать

Вот код. Я знаю, что у него нет обработки ошибок - какие-либо предложения по решению этой проблемы или, может быть, что заставляет замораживать 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 
+1

Добавьте в первую строку к вашему югу: 'Application.ScreenUpdating = false' и добавьте другую строку прямо перед' End Sub': 'Application.ScreenUpdating = true' –

+0

где происходит сбой? (какая строка и т. д.) –

+0

У меня нет возможности проверить, где она раздавится ... Она добавит лист в первые 4 или 5 файлов, а затем сбой без возможности проверить, где это произошло ... – Saint

ответ

7

я, наконец, решить мою проблему ...

Решение было добавить строку кода:

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

после строки:

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

, что позволило время для скопируйте лист в новый файл excel.

До сих пор он работал как шарм.

Я хочу поблагодарить всех, кто помог мне в этом вопросе.

Большое спасибо.

+0

Нет дальнейших ошибок или возникли проблемы ... – Saint

9

Итак, несколько советов для вас:

первым. (Согласно комментариям)

Добавить в качестве первой линии к вашим подразделам: Application.ScreenUpdating = false и добавить другие права строки перед тем End Sub: Application.ScreenUpdating = true

2-й. Переместить эту строку (это установка ссылки Констанция):

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 файлами требует много времени.

+1

3-я точка важна - она ​​даст вам представление о том, работает ли ваш суб-файл. –

+6

также добавьте DoEvents перед каждым циклом. Это гарантирует, что excel продолжает обновляться и оставаться немного отзывчивым. –

+0

@KazJaw - все тот же ... – Saint

Смежные вопросы