Realtime data NOW,ODIN,TradeTiger,Google,Yahoo > AmiBroker, Fcharts, Qtstalker

[josh1]

Public Sub Stop_Timer() ' This subroutine is called by pressing "Stop RT Data" button
TimerActive = False
MsgBox ("Realtime feed stopped")
AB.SaveDatabase 'To Save the database before closing AmiBroker
Set AB = Nothing 'Close the active instance of AmiBroker

End Sub

 

[josh1]

Private Sub Timer()
NSENOW = MyBook.Sheets("Now").Cells(2, 2).Value 'Yes = Now/Nest/ODIN/TT realtime data to be pushed to AmiBroker
Yahoo = MyBook.Sheets("Now").Cells(3, 2).Value 'Yes = Yahoo realtime data to be pushed to AmiBroker
If TimerActive = True Then
If Yahoo = "Yes" Then
GetData 'Calls GetData Sub to get Yahoo Quotes from their site
End If
MakeCSV 'Calls Subroutine for generating csv file
CallAmiBroker 'Calls AmiBroker for importing file
Application.OnTime NOW() + TimeValue("00:00:03"), "Timer" 'This code runs the Timer subroutine every 3 seconds
End If
End Sub

 

[josh1]

' This subroutine tells AmiBroker to import quotes from MyCSV text file using format given in RTG3.format file
Sub CallAmiBroker()
Call AB.Import(0, FileName, "RTG3.format")
Call AB.RefreshAll
End Sub

 

[josh1]

This routine opens AmiBroker and loads database -

Sub InitialiseAB()
On Error Resume Next
Set AB = GetObject(, "Broker.Application")
If AB Is Nothing Then ' True if not running
Set AB = CreateObject("Broker.Application")
End If
AB.Visible = True
ABPath = AB.DatabasePath
DBPath = MyBook.Sheets("Now").Cells(1, 2).Value 'Database path is obtained from Cell "B2"
If ABPath <> DBPath Then
AB.LoadDatabase (DBPath) ' here we set the database path
End If
AB.LoadLayout ("Realtime")
AB.Window.LoadTemplate ("NowRT.Chart")

End Sub

 

[josh1]

This routine creates the text file of quotes. We write quotes one row after another into text file.

Sub MakeCSV()

Dim fs As Object, a As Object, y As Object, C As Integer, i As Integer, r As Integer, S As String, t As String, CellValue As String
'Create a file object for writing
Set fs = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
MkDir ("C:\RT") 'This will create a folder RT in C Drive.
FileName = "C:\RT\MyCSV.txt" 'This file is used to write quotes
Set a = fs.CreateTextFile(FileName, True) 'Here we create the file MyCSV.csv

If NSENOW = "Yes" Then
MyBook.Sheets("Now").Select 'Selects sheet containing quotations

For r = 8 To Range("A65536").End(xlUp).Row
S = Date & ","
C = 1
While Not IsEmpty(Cells(r, C))
CellValue = Cells(r, C).Value '
S = S & CellValue & "," 'Add contents of current cell to string 's' and a comma
C = C + 1
Wend
a.writeline S 'write line
Next r
End If

If Yahoo = "Yes" Then
For r = 7 To Range("K65536").End(xlUp).Row
S = ""
C = 10
While Not IsEmpty(Cells(r, C))
If C = 12 Then
(increment LTT of Yahoo by 3 seconds since Yahoo LTT is in minutes)
CellValue = Cells(r, 16).Value + Secs
Else

CellValue = Cells(r, C).Value '
End If
S = S & CellValue & "," 'Add contents of current cell to string 's' and a comma
C = C + 1
Wend

'Check whether Trading time is within market time, else Yahoo gives quotes after market time also.
If Cells(r, 16).Value >= 0.64583 Then
ElseIf Cells(r, 16).Value <= 0.38542 Then
Else 'Debug.Print "time is correct"

a.writeline S 'write line
End If

Next r
End If
End Sub

 

[josh1]

Module2 subroutines are based on Gummy-stuff.org to get quotes from Yahoo Finance and parse it into columns.

Sub GetData()

Dim QuerySheet As Worksheet
Dim DataSheet As Worksheet
Dim qurl As String
Dim i As Integer
Dim C As Integer, r As Integer, S As String, t As String, CellValue As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

DeleteAllQueries
Set DataSheet = MyBook.Sheets("Now")

Range("J7").CurrentRegion.ClearContents
i = 7
qurl = "http://download.finance.yahoo.com/d/quotes.csv?s="

While Cells(i, "H") <> ""
qurl = qurl + "+" + Cells(i, "H")
i = i + 1
Wend
qurl = qurl + "&f=" + Range("J2")
Range("J1") = qurl
QueryQuote:
With MyBook.Sheets("Now").QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("J7"))
.BackgroundQuery = True
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
'Setting BackgroundQuery False makes it so that the code will block on the refresh call, _
so that it will wait until the query is done executing before continuing onto the rest of the code.
.SaveData = True
End With

Range("J7").CurrentRegion.TextToColumns Destination:=Range("J7"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, other:=False


'turn calculation back on
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Columns("J:J").ColumnWidth = 12

If IST <> Range("Q7") Then
'Debug.Print IST & "- " & Range("R7") & "-" & Secs
IST = Range("Q7")
Secs = TimeValue("00:00:03")
Else
Secs = Secs + TimeValue("00:00:03")
End If
End Sub


Sub DeleteAllQueries()

Dim qt As QueryTable
Dim WSh As Worksheet

For Each WSh In ThisWorkbook.Worksheets
For Each qt In WSh.QueryTables
qt.Delete
Next qt
Next WSh

End Sub

 

[josh1]

Code in RTG3.xlsm is more or less the same except Module2 where we get quotes from Google Finance. You can see the complexity. If anybody can help in further optimising, that person is welcome.

Sub GetGoogleData()

Dim QuerySheet As Worksheet
Dim DataSheet As Worksheet
Dim qurl As String
Dim i As Integer
Dim C As Integer, R As Integer, S As String, t As String, CellValue As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

DeleteAllQueries
Set DataSheet = MyBook.Sheets("Google")

MyBook.Sheets("Now").Select

i = 7
qurl = "http://finance.google.com/finance/info?client=ig&q="

While Cells(i, "H") <> ""
qurl = qurl + "NSE:" + Cells(i, "H") + ","
i = i + 1
Wend
qurl = Left(qurl, Len(qurl) - 1) 'remove last comma
Range("I1") = qurl

QueryQuote:
With MyBook.Sheets("Google").QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("L1"))
.BackgroundQuery = True
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
'Setting BackgroundQuery False makes it so that the code will block on the refresh call, _
so that it will wait until the query is done executing before continuing onto the rest of the code.
.SaveData = True
End With

With MyBook.Sheets("Google")
.Range("A2").CurrentRegion.ClearContents
End With
With MyBook.Sheets("Google").Range("L:O")
.Replace What:=",", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:=" GMT+05:30", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End With
With MyBook.Sheets("Google").Range("L:L")
.TextToColumns Destination:=Range("L1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="""", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5 _
, 1)), TrailingMinusNumbers:=True
End With

With MyBook.Sheets("Google")
i = 1
For i = 1 To .Range("M65536").End(xlUp).Row
If .Cells(i, "M").Value = "t" Then
.Cells(i, "O").Copy Destination:=MyBook.Sheets("Google").Range("A65536").End(xlUp).Offset(1, 0)
End If

If .Cells(i, "M").Value = "l" Then
.Cells(i, "O").Copy Destination:=MyBook.Sheets("Google").Range("B65536").End(xlUp).Offset(1, 0)
End If

If .Cells(i, "M").Value = "ltt" Then
S = .Cells(i, "O")
S = Left(S, Len(S) - 2) & " " & Right(S, 2)
.Cells(i, "O") = S
.Cells(i, "O").Copy Destination:=MyBook.Sheets("Google").Range("C65536").End(xlUp).Offset(1, 0)
End If
Next i
End With


' turn calculation back on
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True

' Google gives Time in HH:MM format hence add 3 seconds every time
If IST <> Range("I7") Then
'Debug.Print IST & "- " & Range("R7") & "-" & Secs
IST = Range("I7")
Secs = RP
Else
Secs = Secs + TimeValue("00:00:03")
End If

End Sub


Sub DeleteAllQueries()

Dim qt As QueryTable
Dim WSh As Worksheet

For Each WSh In ThisWorkbook.Worksheets
For Each qt In WSh.QueryTables
qt.Delete
Next qt
Next WSh

End Sub

 

[josh1]

This code in StartTimer subroutine sets the refresh interval for Google RT feed

If GetGoogle = "Yes" Then
RP = TimeValue("00:00:05") 'Keep this 5 seconds or more else Google may block you.
Else
RP = TimeValue("00:00:03")
End If

 

[josh1]

Code for NowBackfil.xlsm is in Module1.

This subroutine generates the text file containing quotes. In this case we are saving entire Sheet1 as text file called Nowbackfil.csv in the folder "C:\RT". This file is imported by AmiBroker with the help of Nest.format file.

Sub GenerateCSV()
'This generates .csv file containing quotations
FileName = "C:\RT\NowBackfil.csv"
Application.Goto Workbooks("NowBackfil.xlsm").Sheets("Sheet1").Cells(1, 1) 'Selects sheet containing quotations
If Cells(1, 1).Value = "" Then
MsgBox ("Please paste data into Cell A1 of this sheet from NOW/NEST first")
Exit Sub
Else
On Error Resume Next
Set wbTarget = Workbooks("NSE-NOW-RT2.1.xlsm")
If Err.Number <> 0 Then
MsgBox ("If Realtime feed is running," _
& "Go to AmiBroker and save your database first ")
Err.Clear
End If
End If

If MsgBox("Do you want to split Date_Time into separate columns", vbYesNo) = vbYes Then
Application.DisplayAlerts = False
Columns("C:C").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("B:B").Select
Range("B1").Activate
Selection.Copy
Columns("C:C").Select
Range("C1").Activate
ActiveSheet.Paste
Columns("B:B").Select
Range("B1").Activate
Application.CutCopyMode = False
Selection.NumberFormat = "d/m/yyyy"
Columns("C:C").Select
Range("C1").Activate
Selection.NumberFormat = "HH:MM:SS:" ' "[$-F400]h:mm:ss AM/PM"
End If

Workbooks("NowBackfil.xlsm").Sheets("Sheet1").Copy 'Copies that sheet to new Workbook. This is necessary since csv file is flat.
'Excel save only one sheet.
Application.DisplayAlerts = False
ActiveWorkbook.SaveAS FileName:="C:\RT\NowBackfil", FileFormat:=xlCSV, CreateBackup:=False 'saved new workbook as C:\RT\NowBackfil.csv
ActiveWindow.Close 'Closed the new workbook
CallAmiBroker

End Sub

 

[josh1]

My series of articles is complete. Readers are welcome to post their comments