The following code works fine on one two or maybe three passes through... and then Excel crashes.

It simply loops through a folder of excel files one by one. It opens one, opens the new template, and copies and pastes a bunch of data from the old to the new template. Then it saves the new template in a new folder, with the same filename as the original. Then it repeats for the next original file..

Each file, and the template, is about 1mb in size (xlsx), and there 50 or so files in the set, i.e. the code needs to complete 50 loops without crashing!

I don't know why it crashes, as the code works for one loop, so why not all loops?! It just hangs with the regular "RESTART EXCEL?" dialog box.

A memory problem? Can anyone advise of a better way to do this, or how to manage the memory issue properly if that is indeed the problem?

Thanks in advance for any life saving help!!

Stuart




Sub UpgradeFiles()
Dim strFile As String
Dim strPath As String
Dim strOriginalsPath As String
Dim strSaveToPath As String
Dim strPW As String
Dim strSheet As String
Dim strFrom As String
Dim strRange As String
Dim strFromFolder As String
Dim strToFolder As String
Dim wbkOriginal As Workbook
Dim wbkTemplate As Workbook
Dim strTemplate As String
Dim wksTarget As Worksheet
Dim wksCopied As Worksheet
Dim calcstate As Integer

Application.DisplayAlerts = False
Application.ScreenUpdating = False

calcstate = Application.Calculation
Application.Calculation = xlCalculationManual

strFromFolder = ThisWorkbook.Names("FROM").RefersToRange.Value
strToFolder = ThisWorkbook.Names("TO").RefersToRange.Value
strTemplate = ThisWorkbook.Names("NEW").RefersToRange.Value

strPath = ThisWorkbook.Path & "\"
strOriginalsPath = strPath & strFromFolder & "\"
strSaveToPath = strPath & strToFolder & "\"
strPW = ThisWorkbook.Names("PW").RefersToRange.Value

strFile = Dir(strOriginalsPath)

Do While Len(strFile) 0

If strFile = ThisWorkbook.Name Then GoTo nxt
Debug.Print strFile
' Stop
On Error Resume Next
Set wbkOriginal = Application.Workbooks.Open(strOriginalsPath & strFile, Password:=strPW, UpdateLinks:=False)
Err.Clear
If wbkOriginal Is Nothing Then
Set wbkOriginal = Application.Workbooks.Open(strOriginalsPath & strFile, UpdateLinks:=False)
If wbkOriginal Is Nothing Then
If MsgBox("The file failed to open - cancel the upgrade?", vbYesNo) = vbYes Then
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Exit Sub
End If
GoTo nxt
End If
End If

Set wbkTemplate = Application.Workbooks.Open(strPath & strTemplate, UpdateLinks:=False)

''Upgrade
Upgrade wbkOriginal, wbkTemplate

Calculate
Err.Clear
On Error GoTo 0
wbkOriginal.Close SaveChanges:=False
wbkTemplate.Close SaveChanges:=True, Filename:=strSaveToPath & strFile

Err.Clear
Set wbkOriginal = Nothing
Set wbkTemplate = Nothing
On Error GoTo 0
nxt:
strFile = Dir
Loop

Application.Calculation = calcstate
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub




Sub Upgrade(ByRef wbkOld As Workbook, ByRef wbkNew As Workbook)

'Does a bunch of copying and pasting between wbkOld and wbkNew, multiple versions along these lines

wbkOld.Activate
Range("G32:G34").Select ''Or some other range
Application.CutCopyMode = False
Selection.Copy
wbkNew.Activate
Range("G32").Select ''Or some other destination
ActiveSheet.Paste

Application.CutCopyMode = False

''And repeat multiple times for multiple ranges....

End Sub