Question

[编辑]我解决了这个问题：整夜没有足够的内存来存储秒数。因此，将其更改为Long类型，效果很好。现在，我有一个不断更新的Excel，数据库，CAD程序和链接的Excel，全天候24-7自动化！ #SoHappy #CodeUpdatedBelow

从Excel的ThisWorkbook模块中，我正在使用Application.OnTime来调用Module1中的一个子项，它将把启用宏的工作簿保存为2003 xls文件类型，打开Access数据库，刷新链接到的数据库表。该2003 xls，关闭Access，再次打开原始xlsm（触发一个新计时器），最后关闭2003 xls。计时器设置在Workbook_Open上，并在Workbook_BeforeClose上终止

由于某种原因，它正在泄漏内存（我认为），因此运行代码的计算机在下午（给予或占用）之前耗尽了内存。

任何人都可以发现我在做什么错，即为什么它占用了所有的内存吗？

我知道的一件事是，我实际上从未关闭过xlsm文件：它另存为xls。这意味着理论上的Workbook_BeforeClose事件从不触发取消计时器的操作。但是，由于时间（公共变量MyTime）过去了，所以这不是重复循环……我希望这不是原因。

我用访问路径的APATH和Excel路径的EPATH替换了Module1中的路径-这些不是错误的变量，而是硬编码在原始变量中（懒惰，我吗？！）...

ThisWorkbook看起来像这样：

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看起来像这样：

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

非常感谢您的帮助！

Answer 1

第二秒需要更多的内存来保持一整夜的秒数，这就是为什么它在开放时间内总是在最后一次运行中失败的原因。更改为Long类型，而不是整数。

通过运行saveas 2003 xls的连续循环，重新打开xlsm，关闭2003 xls来耗尽内存

1 个答案: