VBA for financial professionals: Reuters Extract

The GetFromReuters function retrieves data based on the Fields passed for a particular RIC. It is called from the FuturesQuotes subroutine further below.

Private Function GetFromReuters(ByVal RIC As String, Fields() As String)

Dim appReuters As AdxRtList

Dim Done As Boolean, i As Long, tmpArray As Variant

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)

Loops = 0

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 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

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 next 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.

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 following 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 Assistance part of the Power 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, LoopsAs 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

VbaFin.com