Память заканчивается из-за запуска непрерывного цикла saveas 2003 xls, повторного открытия xlsm, закрытия 2003 xls

[EDIT] Я решил это: Integer не хватает памяти на количество секунд за одну ночь. Итак, изменился на тип Long, и он отлично работает. Теперь у меня есть постоянно обновляемый Excel, база данных, программа САПР и связанный с ней Excel, полностью автоматизированный 24 часа в сутки 7 дней в неделю! #SoHappy #CodeUpdatedBelow

В модуле ThisWorkbook в Excel я использую Application.OnTime для вызова подпрограммы в Module1, которая сохранит рабочую книгу с поддержкой макросов в тип файла 2003 xls, откроет базу данных Access, обновит таблицу базы данных, связанную с этим xls 2003, закроет Access, снова откройте исходный xlsm (запускает новый таймер) и, наконец, закройте xls 2003 года. Таймер установлен на Workbook_Open и остановлен на Workbook_BeforeClose

По какой-то причине происходит утечка памяти (я думаю), поэтому компьютеру, на котором выполняется код, к полудню заканчивается память (плюс-минус).

Может ли кто-нибудь заметить, что я делаю неправильно, то есть почему он занимает всю эту память?

1 вещь, о которой я знаю, это то, что я никогда не закрываю файл xlsm: он сохраняется как xls. Это означает, что событие Workbook_BeforeClose теоретически никогда не срабатывает для отмены таймера. Но, поскольку время (общедоступная переменная MyTime) уже прошло, и это не повторяющийся цикл... Я надеюсь, что причина не в этом.

Я заменил пути в Module1 на APATH для пути доступа и EPATH для пути Excel - это не ошибочные переменные, а жестко запрограммированные в оригинале (ленивый, я?!)...

Эта рабочая тетрадь выглядит так:

Dim MyTime As Date

Private Sub Workbook_Open()

'Just in case you need to debug
'Uncomment these 3 lines and click "No" on workbook open
'Dim Ans As Variant
'Ans = MsgBox("Do you want to run RefreshOnTime?", vbYesNo, "Yes/No")
'If Ans = vbYes Then RefreshOnTime

RefreshOnTime

End Sub

Sub RefreshOnTime()

Dim Seconds As Long
Dim OfficeOpens As Integer
Dim OfficeCloses As Integer
Dim Delay As Integer

'Delay in seconds
Delay = 240
OfficeOpens = 7
OfficeCloses = 17

'If in working hours
If Hour(Time) >= OfficeOpens And Hour(Time) < OfficeCloses Then
    Seconds = Delay
'If in the morning
ElseIf Hour(Time) < OfficeOpens Then
    Seconds = (OfficeOpens - Hour(Time)) * 3600 + Delay
'If after 5pm take 23:00 as highest hour of day, minus current hour
'Add 7 for morning
'Add 1 to take from 2300 to to midnight
ElseIf Hour(Time) >= OfficeCloses Then
    Seconds = (23 - Hour(Time) + OfficeOpens + 1) * 3600 + Delay
End If

Debug.Print "Seconds = " & Seconds

MyTime = DateAdd("s", Seconds, Time)
Debug.Print "RefreshData will run at " & MyTime

'REPLACE MODULE1 with the right module
'REPLACE RefreshData with the name of your sub
Application.OnTime MyTime, "Module1.RefreshData"

End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)

'REPLACE MODULE1 with the right module
'REPLACE RefreshData with the name of your sub
Application.OnTime MyTime, "Thisworkbook.RefreshData", , False


End Sub

Модуль1 выглядит так:

Sub RefreshData()

'Application.ScreenUpdating = False

'Rebuild all calculations
Application.CalculateFullRebuild

'Refresh all data connections
Application.Workbooks("Materials.xlsm").RefreshAll

'Complete all refresh events before moving on
DoEvents

Debug.Print "Data Refreshed at " & Time

Call SaveAsOld

If Application.ScreenUpdating = False Then Application.ScreenUpdating = True

Debug.Print "Operation Complete at " & Time

End Sub

Sub SaveAsOld()

On Error Resume Next

'Disable Screen Updating
'Application.ScreenUpdating = False

'Save Current
ThisWorkbook.Save

DoEvents

Debug.Print "Macro Workbook Saved at " & Time

'Disable alerts
Application.DisplayAlerts = False

'Save As 2003 and overwrite
ThisWorkbook.SaveAs Filename: = "EPATH\Materials_2003.xls", FileFormat:=56

Debug.Print "2003 xls copy saved at " & Time

'Enable Alerts
Application.DisplayAlerts = True

'Open the macro copy
Application.Workbooks.Open Filename: = "EPATH\Materials.xlsm"

''Enable ScreenUpdating
'If Application.ScreenUpdating = False Then Application.ScreenUpdating = True

ThisWorkbook.Activate

Debug.Print "Macro version opened at " & Time

Call DBOpenClose

'Close the 2003 copy
Application.Workbooks("Materials_2003.xls").Close (SaveChanges = True)

Debug.Print "2003 xls copy closed at " & Time

End Sub


Sub DBOpenClose()

Debug.Print "DBOpenClose Started at " & Time

Dim appAccess As Access.Application

Set appAccess = New Access.Application

appAccess.Visible = True

Call OpenCurrentDatabase("APath\MCMat.mdb")

Debug.Print "Access db opened at " & Time

CurrentDb.TableDefs("CADT").RefreshLink

Debug.Print "CADT Table refreshed at " & Time

Call CloseCurrentDatabase

Debug.Print "Access DB Closed at " & Time

End Sub

Большое спасибо за Вашу помощь!