Таймер или код, не прилипающий к расписанию

Question

У меня есть код, где я обращаюсь к XML-каналу для данных в реальном времени. Мне нужно фиксировать цену каждые 3 минуты, и она должна быть красивой, иначе она сбросит другие вычисления.

Я установил таймер для запуска кода каждые 3 минуты или любой промежуток, который я выбираю.

Я начал замечать проскальзывание, которое было вторым или двумя вначале, но превратилось в 10 секунд в местах. Есть предположения?

Sub xmlData() 

Dim aSwitch As String: aSwitch = Sheet2.[Switch].Value 
Dim aSymbol As String: aSymbol = Sheet2.[Symbol].Value 

'check [switch] status 
If aSwitch = "OFF" Then 
    MsgBox "Switch is OFF!", vbCritical, "Program Status" 
    Exit Sub 
End If 

'MsgBox "Program is ON!", vbCritical, "Program Status" 

'refresh xml data 
Dim iMap As XmlMap 
Set iMap = ActiveWorkbook.XmlMaps(1) 
iMap.DataBinding.LoadSettings "http://****.com/webservice/v1/symbols/" & aSymbol & "/quote" 
iMap.DataBinding.Refresh 

'dim inputs 
Dim aStart As String: aStart = Sheet2.Range("c3").Text 
Dim aInterval As String: aInterval = Sheet2.Range("d3").Text 
Dim aStatus As String: aStatus = Sheet2.[Status].Value 
'oth 
Dim aSecurity As String: aSecurity = Sheet2.[Security].Value 
Dim aPrice As String: aPrice = Sheet2.[Price].Value 
Dim aDatetime As String: aDatetime = Sheet2.[DateTime].Value 

'separate adatetime 
Dim aDate As String: aDate = Mid(aDatetime, 1, 10) 
Dim aTime As String: aTime = Mid(aDatetime, 12, 10) 

'Time actual 
Dim aTimeNow As String: aTimeNow = Format(Now(), "HH:mm:ss") 

'copy xml data to table 
Dim aRow As Long 

aRow = Sheet2.Cells.Find(What:="*", SearchOrder:=xlRows, _ 
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1 

Sheet2.Cells(aRow, 1).Value = aDate 
Sheet2.Cells(aRow, 2).Value = aTime 
Sheet2.Cells(aRow, 3).Value = aSecurity 
Sheet2.Cells(aRow, 4).Value = aPrice 
Sheet2.Cells(aRow, 5).Value = aTimeNow 

'start timer for reload 
Application.OnTime Now + TimeValue(aInterval), "xmlData" 

End Sub 

EDIT 160627

Возможно ли XML не выборки сразу?

Answer 1

Рассчитать запланированное время в абсолютном выражении, а не как дифференциал от Now. (Теперь всегда будет некоторое количество времени после последнего запланированного времени, поэтому всегда будет ползать)

Sub xmlData() 
    Static ScheduleTime As Variant ' Statis retains value between executions 
    Dim aInterval As String 

    ' other code 
    ' ... 

    If ScheduleTime = 0 Then 
     ' initialise on first execution 
     ScheduleTime = Now + TimeValue(aInterval) 
    Else 
     ' schedule based on last scheduled time 
     ' this assumes execution time is always less than interval 
     ScheduleTime = ScheduleTime + TimeValue(aInterval) 
    End If 

    Application.OnTime Now + TimeValue(aInterval), "xmlData" 

End Sub