' The GetFromReuters function retrieves data based on the Fields passed for a particular RIC.
' It is called from the FuturesQuotes subroutine further below.
Function GetFromReuters(ByVal RIC As String, Fields() As String)
 
    Dim appReuters As AdxRtList, Done As Boolean, i As Long, tmpArray As Variant, Loops As Long
    Const MaxLoops = 2500000
  
    Set appReuters = New AdxRtList
    appReuters.Source = "IDN"                            ' set feed name
    appReuters.RegisterItems RIC, Fields                 ' perform registration
    appReuters.StartUpdates (RT_MODE_ONUPDATE)           ' ask for updates - RUNNING
    tmpArray = appReuters.ListFields(RIC, RT_FRV_ALL, RT_FCV_VALUE)
    Do
        Done = True
        For i = 0 To UBound(tmpArray)
            If Not IsNumeric(tmpArray(i, 1)) Then
                Done = False
                Exit For
            End If
        Next i
        If Done Then
            appReuters.CloseAllLinks
            appReuters.UnregisterAllItems
            Exit Do
        Else
            DoEvents
            tmpArray = appReuters.ListFields(RIC, RT_FRV_ALL, RT_FCV_VALUE)
            Loops = Loops + 1
            If Loops > MaxLoops Then Exit Do
        End If
    Loop
  
    Set appReuters = Nothing
    GetFromReuters = tmpArray
  
End Function

' The example retrieves the Historical Closing Levels of the futures for 3 indices - SPX, SP, STXR.
' Remove the “/” if Real Time data is available and needed.
' The Data (symbol and level) are written in a “;” delimited text file.
Sub FuturesQuotes()
 
    Dim MonthCodes(1 To 12) As String, FuturesCodes(1 To 3) As String, RICs(1 To 12) As String
    Dim fs As FileSystemObject, ft As TextStream, fDate As Variant
    Dim Field(0 To 0) As String, i As Long, j As Long, f As Long, fDate As Variant
 
    On Error GoTo Errhdl
    Const FileName = "myFolderFutprices" & Format(Date, "mmddyy") & ".txt"
 
    Set fs = New FileSystemObject
    Set ft = fs.CreateTextFile(FileName, True)
 
    Field(0) = "HISTORIC CLOSE"
 
    FuturesCodes(1) = "/SXF"
    FuturesCodes(2) = "/SP"
    FuturesCodes(3) = "/STXE"
    MonthCodes(1) = "F"
    MonthCodes(2) = "G"
    MonthCodes(3) = "H"
    MonthCodes(4) = "J"
    MonthCodes(5) = "K"
    MonthCodes(6) = "M"
    MonthCodes(7) = "N"
    MonthCodes(8) = "Q"
    MonthCodes(9) = "U"
    MonthCodes(10) = "V"
    MonthCodes(11) = "X"
    MonthCodes(12) = "Z"
    For f = 1 To UBound(FuturesCodes)
        For i = 1 To 12
            j = 0
            Do
                fDate = i & "/" & Day(Date) - j & "/" & Year(Date)
                j = j + 1
            Loop While Not IsDate(fDate)
            fDate = CDate(fDate)
            If fDate >= Date Then
                RICs(i) = FuturesCodes(f) & MonthCodes(i) & Right(Format(Date, "yy"), 1)
            Else
                RICs(i) = FuturesCodes(f) & MonthCodes(i) & Right(Format(DateAdd("yyyy", 1, Date), "yy"), 1)
            End If
            tmpVal = GetFromReuters(RICs(i), Field)
            If IsNumeric(tmpVal(0, 1)) Then
                ft.WriteLine RICs(i) & ";" & tmpVal(0, 1)
            End If
        Next i
    Next f
    ft.Close
 
Errhdl:
    If Err.Number Then MsgBox "The VBA project generated an error" & Err.Description, vbCritical, _
    "Futures Quotes"
    Set appReuter = Nothing
    Set ft = Nothing
    Set fs = Nothing
 
End Sub


' The example uses AdxRtHistory class to load into memory data of custom Type called FixingsData.
' Last is the next element of the FixingsData array being loaded into memory for future use.
' The data being retrieved is the close in the case of equities and Bid in the case of interest rates.
' Put in a different module or move the Public and Global declarations at the top of this module
Public Type FixingsData
    Name As Variant
    Dates() As Variant
    Prices() As Variant
    ExDates() As Variant
    Dividends() As Variant
    Frequency As Variant
End Type
Global rtData() As FixingsData

Sub LoadRICData(RIC As String, Last As Long)
 
    Dim RH As AdxRtHistory
    Dim Fields(0 To 1) As String
 
    Fields(0) = "DATE"
    If InStr(RIC, "=") > 0 Then
        Fields(1) = "BID"
    Else
        Fields(1) = "CLOSE"
    End If
 
    Set RH = New AdxRtHistory
    With RH
        .Source = "IDN"
        .ItemName = RIC
        ModeStr = "START:" & UCase(Format(Date - 365, "DD/MMM/YYYY")) & " END:" & _
        UCase(Format(Date, "DD/MMM/YYYY"))
        .Mode = ModeStr
        .RequestHistory Fields
        While .RunStatus = RT_RS_BUSY
            DoEvents
        Wend
        If Len(.ErrorString) = 0 Then
            ReDim Preserve rtData(1 To Last)
            ReDim rtData(Last).Dates(UBound(.Data, 2) + 1)
            ReDim rtData(Last).Prices(UBound(.Data, 2) + 1)
            For i = 0 To UBound(.Data, 2)
                rtData(Last).Dates(i + 1) = .Data(0, i)
                rtData(Last).Prices(i + 1) = .Data(1, i)
            Next i
            rtData(Last).Name = RIC
        End If
        .FlushData
    End With
 
End Sub

' The subroutine takes an array of Stock symbols, retrieves some dividends data (Ex Date, Pay Date, Dividend Amount, Currency)
' with announcement date less than a year and writes it in a “;” delimited text file.
' The fields can be obtained by using the Security History Wizard of the Reuters>Assistant menu of the PowerPlus Pro add in.
Sub GetDividends(StockSymbols() As String)
 
    Dim DH As MrvInstrument, StockFile As String, fs As FileSystemObject, ft As TextStream
    Dim i As Long, Loops As Long, ErrorString As String, Symbol As String, dData As Variant, tmpStr As String
    Dim Fields(0 To 3) As String
    Fields(0) = "DPS_EX_DATE"
    Fields(1) = "DPS_PAY_DATE"
    Fields(2) = "DPS_GROSS_UNADJ"
    Fields(3) = "DPS_CCY_CODE"
    Condition = "DPS_ANNOUNCE_DATE:T-1Y<T"
    Const myFolder = "myFolder"
    Const MaxLoops = 1000000
 
    Set DH = New MrvInstrument
    Set fs = New FileSystemObject
    StockFile = myFolder & "Dividends" & Format(Date, "mmddyy") & ".txt"
    Set ft = fs.OpenTextFile(StockFile, ForWriting, True)
    For i = 1 To UBound(StockSymbols)
        Symbol = StockSymbols(i)
        With DH
             .Mode = "SOURCE:EQUITY MATRIX:YES"
             .InstrumentID = Symbol
             .RequestTimeSeries "DIVIDEND_HISTORY", Fields, Condition
             Do While DH.RunStatus = DE_RS_BUSY
                 DoEvents
                 Loops = Loops + 1
                 If Loops > MaxLoops Then Exit Do
             Loop
             If Loops > MaxLoops Then Debug.Print Symbol
             If IsError(.ErrorString) Then
                 ErrorString = "#Error"
             Else
                 ErrorString = .ErrorString
             End If
             If Len(ErrorString) = 0 Then
                 For j = 1 To UBound(.Data, 2)
                     For k = 1 To 4
                         dData(k) = .Data(k, j)
                         If IsError(dData(k)) Then dData(k) = "#N/A N/A"
                     Next k
                     tmpStr = StockSymbols(i) & ";" & dData(1) & ";" & dData(2) & ";" & dData(3) & ";" & dData(4)
                     ft.WriteLine tmpStr
                 Next j
             End If
        End With
    Next i
 
    ft.Close
    Set ft = Nothing
    Set fs = Nothing
    Set DH = Nothing
 
End Sub