[РЕДАКТИРОВАТЬ] Я решил это: Integer не хватает памяти для количества секунд в течение ночи. Итак, изменился на тип Long и он работает нормально. Теперь у меня есть постоянно обновляемый Excel, база данных, программа CAD и связанная Excel полностью автоматизированная 24-7! #SoHappy # CodeUpdatedBelow
В модуле ThisWorkbook в Excel я использую Application.OnTime для вызова подчиненного модуля в Module1, который сохранит книгу с поддержкой макросов в файле типа xls 2003, откроет базу данных Access, обновит таблицу базы данных, связанную с этим 2003 xls, закройте Access, снова откройте исходный xlsm (запускает новый таймер) и, наконец, закройте 2003 xls. Таймер установлен на Workbook_Open и отключен на Workbook_BeforeClose
По какой-то причине это утечка памяти (я думаю), поэтому компьютер, на котором выполняется код, исчерпает память к полудню (дай или забери).
Кто-нибудь может заметить, что я делаю неправильно, то есть, почему он тратит всю эту память?
Одна вещь, о которой я знаю, это то, что я никогда не закрываю файл xlsm: он сохраняется как xls. Это означает, что событие Workbook_BeforeClose теоретически никогда не вызывает отмены таймера. Но, поскольку время (общедоступная переменная MyTime) уже прошло, и это не повторяющийся цикл ... Я надеюсь, что это не причина.
Я заменил пути в Module1 на APATH для Access Path и EPATH для Excel Path - это не ошибочные переменные, а жестко закодированные в оригинале (ленивый, я?!) ...
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
Большое спасибо за вашу помощь!