[Редактировать:] Исправлены теги кода [/ Редактировать]
Я установил таймер (код адаптирован из различных источников).Он вызывает одну подпрограмму, которая содержит строку ThisWorkbook.RefreshAll. Если я запускаю подпрограмму RefreshData, нажимая F5 из нее, она работает нормально.Если я вызываю сабвуфер из сабвуфера Таймер, я получаю ошибку во время выполнения 50290
Данные включают в себя различные запросы к базе данных сервера SQL.
Код:
Попробовал добавить DoEvents после, не ходи.Та же ошибка.
Sub Timer()
Dim TimeOut As Long
'Set Timeout in minutes
TimeOut = 5
If blnTimer Then
lngTimerID = KillTimer(0, lngTimerID)
If lngTimerID = 0 Then
MsgBox "Error: Timer Not Stopped"
Exit Sub
End If
Debug.Print "blnTimer = False"
blnTimer = False
Else
lngTimerID = SetTimer(0, 0, TimeSerial(0, TimeOut, 0), AddressOf RefreshData)
If lngTimerID = 0 Then
MsgBox "Error: Timer Not Generated"
Exit Sub
End If
Debug.Print "blnTimer = True"
blnTimer = True
End If
Debug.Print "Timer Complete at " & Time
End Sub
Sub RefreshData()
'Refresh all data connections
ActiveWorkbook.RefreshAll
'Complete all refresh events before moving on
DoEvents
Debug.Print "Data Refreshed at " & Time
End Sub
Ожидаемый результат - каждые 5 минут будет вызываться подпрограмма RefreshData, которая будет запускать команду ThisWorkbook.RefreshAll и обновлять все внешние подключения к данным.
[Редактировать:]Обновление - я только что попытался сделать Application.CalculateFullRebuild (согласно здесь ) чуть выше RefreshAll, и тот же код ошибки появляется в строке CalculateFullRebuild.Сюжет сгущается ...
[Правка 2] Я опубликую свое полное решение, потому что тогда я ограничил его временем нашего рабочего дня, и это может быть полезно для кого-то, кто также найдет этот пост.Благодарим @EvR за помощь в работе приложения.ПРИМЕЧАНИЕ: приведенный ниже код должен быть в ThisWorkbook, а модуль, который вы хотите запустить, должен быть либо в Module1, либо вы должны изменить Module1 на свой код - и, конечно, изменить имя Sub с RefreshData на sub, оба вподпрограммы start timer и end timer ниже ...
[Edit3]: я забыл включить объявление публичной переменной для MyTime - если вы не используете его в качестве публичной переменной (то есть вне подпрограммы), тогдаПроцедура отмены (ThisWorkbook_BeforeClose) не будет работать, и каждый раз при закрытии книги вы будете получать сообщение об ошибке: для отмены таймера требуется точное значение MyTime.
[Edit4]: должно быть, если timer> =officecloses - в противном случае он установит Seconds = 0, когда час 17:00 ... И он не будет работать снова, пока книга не откроется снова вручную!Обновленный код ниже.
[Edit5]: Секунды должны быть типа Long, потому что, когда я делаю сумму за ночь, в целом числе не хватает памяти для большого количества необходимых секунд!Код обновлен ниже.
[Edit6]: я только что обнаружил, что вы не можете добавить 23 часа к текущему времени (имеет смысл, когда вы думаете об этом - дата возвращается к первой дате Excel).Мне нужно было добавить DateAdd («d», 1, MyTime) и изменить мои первоначальные настройки MyTime, чтобы использовать «Сейчас» вместо «Время» (теперь включает в себя как время, так и дату).Да, я вручную открывал его каждое утро с тех пор, как обнаружил ошибку памяти, и все нормально, закрывался и открывался вручную ... До сегодняшнего дня.Сегодня новый день!!: D Исправленный код ниже.
Public Dim MyTime As Date
Sub RefreshOnTime()
Dim Delay As Integer
Dim OfficeOpens As Integer
Dim OfficeCloses As Integer
Dim Overnight As Integer
Dim DayAdvance As Integer
'Delay in seconds
Delay = 240
'hour of opening
OfficeOpens = 7
'hour of closing (24hr clock)
OfficeCloses = 17
'If in working hours
If Hour(Time) >= OfficeOpens And Hour(Time) < OfficeCloses Then
Overnight = 0
DayAdvance = 0
'If in the morning (e.g. auto open after scheduled reboot at 3am)
ElseIf Hour(Time) < OfficeOpens Then
Overnight = (OfficeOpens - Hour(Time))
DayAdvance = 0
'If after 5pm add 1 to day
'Add morning hours
ElseIf Hour(Time) >= OfficeCloses Then
Overnight = (OfficeOpens - Hour(Time))
DayAdvance = 1
End If
Debug.Print "Hours = " & Overnight
'Add Seconds to current time
MyTime = DateAdd("s", Delay, Now)
Debug.Print "MyTime after adding Seconds = " & MyTime
'Add DayAdvance to MyTime
MyTime = DateAdd("d", DayAdvance, MyTime)
Debug.Print "MyTime after adding DayAdvance = " & MyTime
'Add Overnight to MyTime
MyTime = DateAdd("h", Overnight, MyTime)
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
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