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.
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?
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
So, some tips for you:
1st. (according to comment)
Add as a first line to your sub:
Application.ScreenUpdating = false and add the other line right before
End Sub :
Application.ScreenUpdating = true
2nd. Move this line (it’s setting constance reference):
Set wb = Workbooks("Equipment Further Documentation List.xls")
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
End Sub add additionally this code:
Application.StatusBar = false
As a result you can see in Excel app, in the status bar, file name which is currently in process.
Keep in mind that working with 500 files must be time-consuming.
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:
which allowed time to copy the sheet to the new excel file.
So far it has been working like a charm.
I want to thank everyone that helped me with this issue.