计时器或代码不符合计划

时间:2016-06-27 06:07:32

标签: excel excel-vba vba

我有代码,我正在访问实时货币数据的xml Feed。我需要每隔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

编辑160627

是否有可能不立即获取XML?

1 个答案:

答案 0 :(得分: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