ThisWorkbook.RefreshAll ne fonctionne pas lorsqu'il est appelé à partir d'un sous-système de temporisation

Question

[Edit :] Correction des balises de code [/Edit]

J'ai mis en place un minuteur (code adapté de diverses sources). Il appelle un sub, qui contient la ligne ThisWorkbook.RefreshAll Si j'exécute le sous-système RefreshData en appuyant sur F5 à l'intérieur de celui-ci, cela fonctionne correctement. Si j'appelle le sous-système à partir du sous-système Timer, j'obtiens l'erreur d'exécution 50290.

Les données comprennent diverses requêtes adressées à une base de données du serveur SQL.

Le code :

J'ai essayé d'ajouter DoEvents après, mais rien à faire. Même erreur.

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

Le résultat attendu est que toutes les 5 minutes, le sous-système RefreshData sera appelé, ce qui exécutera la commande ThisWorkbook.RefreshAll et mettra à jour toutes les connexions de données externes.

[Edit :] Mise à jour - Je viens d'essayer de faire une Application.CalculateFullRebuild (comme indiqué dans la section aquí ) juste au-dessus de RefreshAll, et le même code d'erreur apparaît sur la ligne CalculateFullRebuild. L'intrigue se corse...

[Je vais poster ma solution complète, parce que je l'ai limitée à nos heures de bureau et que cela pourrait être utile à quelqu'un qui trouverait ce message également. Merci à @EvR pour l'aide de Application.OnTime ! NOTE : Le code ci-dessous doit être dans ThisWorkbook et le module que vous voulez exécuter doit être dans Module1 ou vous devez changer Module1 à l'endroit où se trouve votre code - et bien sûr changer le nom du Sub de RefreshData à votre sub, à la fois dans le start timer et le end timer subs ci-dessous...

[Edit3] : J'ai oublié d'inclure la déclaration de la variable publique MyTime - si vous ne l'utilisez pas en tant que variable publique (c'est-à-dire en dehors de tout sous-programme), la routine Cancel (ThisWorkbook_BeforeClose) ne fonctionnera pas et vous obtiendrez une erreur à chaque fois que vous fermerez le classeur : elle a besoin de la valeur exacte de MyTime pour annuler la minuterie.

[Edit4] : Doit être si timer >= officecloses - sinon il mettra Seconds = 0 quand l'heure est 17:00... Et il ne s'exécutera plus jusqu'à ce que le classeur s'ouvre à nouveau manuellement ! Le code ci-dessous a été mis à jour.

[Edit5] : Seconds doit être de type Long car lorsque je fais la somme pour la nuit, il n'y a pas assez de mémoire dans un entier pour le grand nombre de secondes nécessaires ! Code mis à jour ci-dessous.

[Edit6] : Je viens de découvrir qu'on ne peut pas ajouter 23 heures à l'heure actuelle (c'est logique quand on y pense - la date retombe à la première date d'Excel). J'ai dû ajouter DateAdd("d", 1, MyTime) et modifier mon réglage initial de MyTime pour utiliser Now au lieu de Time (Now comprend à la fois l'heure et la date). Oui, j'ai ouvert manuellement le programme chaque matin depuis cette date pour trouver l'erreur de mémoire, et j'ai approuvé, fermé et ouvert manuellement... Jusqu'à aujourd'hui. Aujourd'hui est un nouveau jour ! :D Code corrigé ci-dessous.

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

Remplacez votre timer-sub par ce code dans la section ThisWorkbook :

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