从计时器子调用时，ThisWorkbook.RefreshAll 不起作用

Question

[编辑：]固定代码标签[/编辑]

我设置了一个计时器（代码改编自各种来源）。 它调用一个 sub，其中包含行 ThisWorkbook.RefreshAll 如果我通过在其中按 F5 来运行子 RefreshData，它可以正常工作。 如果我从 Timer sub 中调用 sub，我会收到 Run-time Error 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 并更新所有外部数据连接。

[编辑：] 更新 - 我刚刚尝试在 RefreshAll 上方执行 Application.CalculateFullRebuild（根据 here），并且在 CalculateFullRebuild 行上出现相同的错误代码。剧情变厚了……

[编辑 2] 我将发布我的完整解决方案，因为我随后将其限制在我们的办公时间，这可能对找到此帖子的人也有用。感谢 @EvR 的 Application.OnTime 帮助！ 注意：下面的代码必须在 ThisWorkbook 中，并且您要运行的模块必须在 Module1 中，或者您必须将 Module1 更改为您的代码所在的位置 - 当然，将 Sub 的名称从 RefreshData 更改为您的 sub，两者都在下面开始计时器和结束计时器...

[Edit3]：我忘记包含 MyTime 的公共变量声明 - 如果您不将其用作公共变量（即在任何子例程之外），那么取消例程 (ThisWorkbook_BeforeClose) 将不起作用，您将每次关闭工作簿时都会出错：它需要确切的 MyTime 值才能取消计时器。

[Edit4]：如果 timer >= officecloses 应该是 - 否则它将在 17:00 时设置 Seconds = 0...并且在工作簿再次手动打开之前它不会再次运行！以下代码已更新。

[Edit5]: Seconds 必须是 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

Answer 1

用 ThisWorkbook-section 中的代码替换您的 timer-sub：

Dim MyTime As Date

Sub RefreshOnTime()
RefreshData
MyTime = DateAdd("s", 500, Time)
Application.OnTime MyTime, "Thisworkbook.RefreshOnTime"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.OnTime MyTime, "Thisworkbook.RefreshOnTime", , False
End Sub

Private Sub Workbook_Open()
RefreshOnTime
End Sub