Memory runs out by running continuous loop of saveas 2003 xls, reopen xlsm, close 2003 xls

Question

[EDIT] I solved this: Integer doesn't have enough memory for the number of seconds overnight. So, changed to Long type and it works fine. Now I have a continuously updating Excel, database, CAD program and linked Excel fully automated 24-7! #SoHappy #CodeUpdatedBelow

From ThisWorkbook module in Excel, I am using Application.OnTime to call a sub in Module1, which will save a macro-enabled workbook to 2003 xls filetype, open an Access database, refresh a database table which is linked to that 2003 xls, close Access, open the original xlsm again (triggers a new timer) and finally close the 2003 xls. The timer is set on Workbook_Open and killed on Workbook_BeforeClose

For some reason it's leaking memory (I think), so the computer running the code runs out of memory by the afternoon (give or take).

Can anyone spot what I'm doing wrong, i.e. why it's hogging all that memory?

1 thing I'm aware of is I never actually close the xlsm file: it's Saved As a xls. This means the Workbook_BeforeClose event in theory never triggers to cancel the timer. But, since the time (public variable MyTime) is passed by then and it's not a recurring loop... I'm hoping that is not the cause.

I replaced the paths in Module1 with APATH for Access Path and EPATH for Excel Path - those are not erroneous variables, but hard-coded in the original (lazy, me?!)...

ThisWorkbook looks like this:

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

Module1 looks like this:

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

Thanks so much for your help!

jfgoodhew1 jfgoodhew1 · Accepted Answer · 2019-04-18T06:19:38

Seconds required more memory for the number of seconds overnight, that's why it always failed on the last run during open hours. Changed to Long type instead of integer.

Memory runs out by running continuous loop of saveas 2003 xls, reopen xlsm, close 2003 xls

1 Answers