Hi,
I get data from an application to excel. This data is then sent to another application (amibroker) using a macro.This happens in following steps:-
1. From first application data is being sent to excel in realtime.
2. Using macro now this data is then populated in a CSV file.
3. Using macro another application (amibroker ) is called to read the CSV file.
4. This Read - > Write -> Call amibroker , is done repetitively with a selected time interval.
Problem is that step 2 and 3 are taking much time and some of the data although getting into excel from first application is not being picked up by the final application.
Is there any way to make it faster ?
Below is the code :-
----------------------
Dim TimerActive As Boolean
Public FileName As String
Public AB As Object 'Declare AmiBroker as a public variable.
Public ABPath As String 'Declare database path as a public variable
Public DBPath As String 'Variable to collect User'sDatabase path
Public NSENOW As String 'String to hold whether NOW data required
Public MyBook As Workbook 'this holds current workbook name
Public Vol As Variant 'Holds last volume traded today
Public RP As Date 'Holds Refresh period in seconds
Sub StartTimer()
Set MyBook = Workbooks("RTNOW.xlsm")
DBPath = MyBook.Sheets("Now").Cells(1, 2).Value
NSENOW = MyBook.Sheets("Now").Cells(2, 2).Value
Vol = Range("D:D").Value
Application.Wait Now() + TimeValue("00:00:03")
RP = Range("B3")
If DBPath <> "" Then InitialiseAB 'Start AmiBroker
TimerActive = True
Timer ' Calls Timer Subroutine
End Sub
Public Sub Stop_Timer()
TimerActive = False
MsgBox ("Realtime feed stopped")
If DBPath <> "" Then
AB.SaveDatabase
Set AB = Nothing 'Close the active instance of AmiBroker
End If
End Sub
Private Sub Timer()
If TimerActive = True Then
If TimeValue(Now()) >= Range("L4").Value Then
Debug.Print "Time is- " & Now() & " exchange closed"
ElseIf TimeValue(Now()) <= Range("L3").Value Then
Debug.Print "Time is- " & Now() & " exchange not open yet"
Else
MakeCSV 'Calls Subroutine for generating csv file
If DBPath <> "" Then CallAmiBroker 'Calls AmiBroker for importing file
End If
Application.OnTime Now() + RP, "Timer" 'This code runs the Timer subroutine every 3 seconds
End If
End Sub
Sub CallAmiBroker()
Call AB.Import(0, FileName, "RTG3.format")
Call AB.RefreshAll
End Sub
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
If ABPath <> DBPath Then
AB.LoadDatabase (DBPath)
End If
' AB.LoadLayout ("Realtime")
' AB.Window.LoadTemplate ("NowRT.Chart")
End Sub
Sub MakeCSV()
Dim fs As Object, a As Object, C As Integer, i As Integer, R As Integer, S As String, t As Variant, 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 = "R:\MyCSVNOW.txt" 'This file is used to write quotes
Set a = fs.CreateTextFile(FileName, True) 'Here we create the file MyCSV.csv
MyBook.Sheets("Now").Select 'Selects sheet containing quotations
If NSENOW = "Yes" Then
For R = 7 To Range("A65536").End(xlUp).Row
S = Format(Date, "dd/mm/yyyy") & ","
C = 1
While Not IsEmpty(Cells(R, C))
If C = 2 Then
CellValue = Format(Cells(R, C).Value, "HH:mm:ss")
ElseIf C = 4 Then
t = Cells(R, C).Value - (Vol(R, 1))
Vol(R, 1) = Cells(R, C).Value
CellValue = t
' Debug.Print Cells(R, 1).Value & t & " - " & Vol(R, 1)
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
a.writeline S 'write line to the file MyCSV.csv
Next R
End If
End Sub
--------------------
Bookmarks