|
PureBytes Links
Trading Reference Links
|
Yuki
i'm no expert in excel,what little i know i learned by trial and
error, a msft book vba for excel 97 and reading other macro's.
any excel formating in excel is only for excel not ab.
all you want to do is save a csv file and import to ab.
my method was to record a macro,write a little vba in the macro,
record another macro from that point and copy paste to the first
macro. do it in little steps.
here is the complete macro text which should help.
this reads a file of tickers,imports data from quote tracker, saves
the data to csv files and imports the files to ab.
bw
curt
Sub IMPORT_FIRST()
'
' ImportList Macro
' Macro recorded 4/26/02 by HP Authorized Customer
'
'
Dim Tickersht As Worksheet
Dim A As Integer
Dim I As Integer
Dim Tic As String
Dim sPath As String
Windows("QT_To_AB.XLS").Activate
Worksheets("TICKERS").Activate
Range("A1:A80").Select
Selection.ClearContents
Range("A1").Select
Workbooks.OpenText
FileName:="D:\AMIBROKER\IntradayList\TicList.txt", Origin _
:=xlWindows, StartRow:=1, DataType:=xlDelimited,
TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True,
Semicolon:=False, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array
(1, 1)
Range("A1:A80").Select
' SORT TICKERS TO ALPHABETICAL
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A1:A80").Select
Selection.Copy
ActiveWorkbook.Close SaveChanges:=False
Windows("QT_To_AB.xls").Activate
Worksheets("TICKERS").Activate
Range("A1").Select
ActiveSheet.Paste
For I = 1 To 80
Cells(I, 2) = 0
Cells(I, 3) = 0
Next I
DeleteSheet TickList
sPath = "D:\AMIBROKER\IntradayData\"
ChDir "D:\AMIBROKER\IntradayData\"
Tic = Dir(sPath)
If Tic <> "" Then
Do Until Tic = ""
Kill "D:\AMIBROKER\IntradayData\" & Tic
Tic = Dir(sPath)
Loop
End If
MAKE_IQY
End Sub
Sub Import_Day()
'
' Macro2 Macro
' Macro recorded 5/3/02 by HP Authorized Customer
'
Windows("QT_To_AB.XLS").Activate
Sheets("TICKERS").Select
ChDir "D:\AMIBROKER\IntradayList"
Workbooks.Open FileName:="D:\AMIBROKER\IntradayList\Tickers.csv"
Columns("A:C").Select
Selection.Copy
Application.DisplayAlerts = False
ActiveWorkbook.Close SaveChanges:=False
Windows("QT_To_AB.xls").Activate
Worksheets("TICKERS").Activate
Range("A1").Select
ActiveSheet.Paste
MAKE_IQY
End Sub
Sub MAKE_IQY()
'
' MAKE_IQY Macro MUST HAVE QTGETIME.iqy IN PLACE BEFORE FIRST R
' Makes IQY File For Selected Stocks
Dim BASE As String
Dim TICKS As String
Dim LAST As String
Dim Time As String
Dim Ticker As String
Dim A As Long
Dim mrows As Integer
Dim Newmrows As Integer
Dim Ht As String
Dim Mt As String
Dim St As String
Dim Tickersht As Worksheet
Dim StartTime As Variant
BASE = "http://127.0.0.1:16239/Req?Gettimesales("
Windows("QT_To_AB.XLS").Activate
A = 1
Ticker = Worksheets("TICKERS").Cells(A, 1)
Do Until Ticker = ""
Ticker = Worksheets("TICKERS").Cells(A, 1)
Ht = Worksheets("TICKERS").Cells(A, 2)
Mt = Worksheets("TICKERS").Cells(A, 3)
'St = Worksheets("TICKERS").Cells(A, 4)
Time = Ht & ":" & Mt ' & ":" & St
If Ticker > " " Then
TICKS = Worksheets("TICKERS").Cells(A, 1)
LAST = BASE & Ticker & "," & Time & ",0)"
End If
Sheets("QY").Select
ChDir "D:\AMIBROKER\QY\"
Workbooks.OpenText FileName:= _
"D:\AMIBROKER\QY\QTGETIME.iqy", Origin:= _
xlWindows, StartRow:=1, DataType:=xlFixedWidth,
FieldInfo:=Array(0, 1)
Cells(1, 1).Value = ""
Cells(2, 1).Value = ""
Cells(1, 1).Value = LAST
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs FileName:= _
"D:\AMIBROKER\QY\QTGETIME.iqy", FileFormat:= _
xlTextPrinter, CreateBackup:=False
ActiveWindow.Close
'THIS MACRO USES THE IN PLACE QUERY TO IMPORT QUOTES
'
'
Set Tickersht = Worksheets.Add
Tickersht.Name = "QUOTES"
Sheets("QUOTES").Select
Cells.Select
Selection.Delete
With ActiveSheet.QueryTables.Add(Connection:= _
"FINDER;D:\AMIBROKER\QY\QTGETIME.iqy", _
Destination:=Range("A1"))
.FieldNames = False
.RefreshStyle = xlInsertDeleteCells
.RowNumbers = False
.FillAdjacentFormulas = False
.RefreshOnFileOpen = False
.HasAutoFormat = True
.BackgroundQuery = True
.TablesOnlyFromHTML = True
.Refresh BackgroundQuery:=False
.SavePassword = False
.SaveData = True
End With
Columns("A:A").ColumnWidth = 50
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"),
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False,
OtherChar:= _
"", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1),
Array(4, 1), Array(5, 1), _
Array(6, 1), Array(7, 1), Array(8, 1))
Selection.ColumnWidth = 8.71
Rows("1:1").Select
Selection.Delete Shift:=xlUp
mrows = 0
lastcell = 1
Set lastcell = Cells.SpecialCells(xlLastCell)
mrows = lastcell.Row
Newmrows = mrows - 1
If Newmrows > 2 Then
If Cells(1, 6) > 10 * Cells(2, 6) Then
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Newmrows = mrows - 2
End If
If Cells(Newmrows, 6) > 10 * Cells(Newmrows - 1, 6) Then
Rows(Newmrows).Select
Selection.Delete Shift:=xlUp
Newmrows = mrows - 3
End If
ActiveWorkbook.SaveAs FileName:="D:\AMIBROKER\IntradayData\" &
Ticker, _
FileFormat:=xlCSV, CreateBackup:=False
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'Set oAB = CreateObject("Broker.Application")
'FileName = "D:\AMIBROKER\IntradayData\" & Ticker 'Sheets
("QUOTES").Select
'oAB.Import 0, FileName, "Custom1.format"
'oAB.RefreshAll
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'Separate Time
Columns("B:B").Select
Selection.TextToColumns Destination:=Range("B1"),
DataType:=xlDelimited, _
TextQualifier:=xlNone, ConsecutiveDelimiter:=False,
Tab:=True, Semicolon _
:=False, Comma:=True, Space:=False, Other:=True,
OtherChar:=":", _
FieldInfo:=Array(Array(1, 2), Array(2, 1), Array(3, 9))
'xxxx Save Time
Ht = Cells(Newmrows, 2)
Mt = Cells(Newmrows, 3)
Worksheets("TICKERS").Cells(A, 2) = Ht
Worksheets("TICKERS").Cells(A, 3) = Mt
'Worksheets("TICKERS").Cells(A, 4) = St
End If
DeleteSheet Ticker
'A = A + 1
Ticker = Worksheets("TICKERS").Cells(A, 1)
DeleteSheet "QUOTES"
'Loop
If Worksheets("TICKERS").Cells(A + 1, 1) = "" Then
Worksheets("TICKERS").Activate
For I = 1 To 80
If Cells(I, 2) > 0 And Cells(I, 2) < 5 Then
Cells(I, 2) = Cells(I, 2) + 12
End If
If Cells(I, 2) = "" Then
Cells(I, 2) = 0
End If
If Cells(I, 3) = "" Then
Cells(I, 3) = 0
End If
Next I
Columns("A:D").Select
Selection.Copy
Columns("A:D").Select
ActiveSheet.Paste
ChDir "D:\AMIBROKER\IntradayList"
ActiveWorkbook.SaveAs
FileName:="D:\AMIBROKER\IntradayList\Tickers.csv", _
FileFormat:=xlCSV, CreateBackup:=False
Application.DisplayAlerts = False
IMPORT_TO_AB
Start = Timer
Do While Timer < Start + 30
DoEvents
Loop
A = 0
End If
A = A + 1
Loop
End Sub
Sub DeleteSheet(SheetName)
Application.DisplayAlerts = False
On Error Resume Next
Worksheets(SheetName).Delete
End Sub
Sub IMPORT_TO_AB()
Set oAB = CreateObject("Broker.Application")
sPath = "D:\AMIBROKER\IntradayData\"
ChDir "D:\AMIBROKER\IntradayData\"
Tic = Dir(sPath)
If Tic <> "" Then
Do Until Tic = ""
FileName = "D:\AMIBROKER\IntradayData\" & Tic
oAB.Import 0, FileName, "Custom5.format"
Tic = Dir '(sPath)
Loop
End If
oAB.RefreshAll
'Application.Quit
End Sub
------------------------ Yahoo! Groups Sponsor --------------------~-->
Make a clean sweep of pop-up ads. Yahoo! Companion Toolbar.
Now with Pop-Up Blocker. Get it for free!
http://us.click.yahoo.com/L5YrjA/eSIIAA/yQLSAA/GHeqlB/TM
--------------------------------------------------------------------~->
Check AmiBroker web page at:
http://www.amibroker.com/
Check group FAQ at: http://groups.yahoo.com/group/amibroker/files/groupfaq.html
Yahoo! Groups Links
<*> To visit your group on the web, go to:
http://groups.yahoo.com/group/amibroker/
<*> To unsubscribe from this group, send an email to:
amibroker-unsubscribe@xxxxxxxxxxxxxxx
<*> Your use of Yahoo! Groups is subject to:
http://docs.yahoo.com/info/terms/
|