ChrisK
General User
Joined: 25 Jan 2006
Posts: 17
|
 Posted: Tue Feb 14, 2006 2:23 pm Post subject: Downloading Historical Stock Prices |
 |
|
Following DannyB's Stock Price Download Macro, I developed the following code which will download past pricesfor stocks using Yahoo. The only requirements are a file "d:\symbols.csv" (or whatever you specified), a list of Yahoo stock symbols in column A. The resulting CSV file d:\pastprices.csv, will be produced. I've tested it but tell me of any errors. RunGetPastPrices gets prices for the past 2 years from Today and the symbols are in a file called "d:/Symbols.csv"
| Code: |
Sub RunGetPastPrices
Call GetPastPrices(2,"d:/Symbols.csv")
End sub
Sub GetPastPrices(NumberOfYearsAgo as Integer,SymSheet As String)
' Dims
Dim oSheet as object
Dim I as Integer, J as Integer
' Load Symbols.csv Sheet and read Symbols into array
Call ImportCSVFile("Symbols", SymSheet, ThisComponent)
oSheet = ThisComponent.getSheets().getByName("Symbols")
NumRow=getLastUsedRow(oSheet)
Dim Sym(NumRow)
For I = 0 to NumRow
Sym(I) = oSheet.GetCellByPosition(0,I).string
Next I
DeleteSheet("Symbols")
' Add a Sheet for PastPricesList
NewOrReplaceSheet("PastPrices")
oSheet = ThisComponent.getSheets().getByName("PastPrices")
' Go Through Sym Array and download past prices starting on StartDate
StartRow=0
For I = LBound(Sym()) to UBound(Sym())
PastPriceList=PastPrices(Sym(I),NumberOfYearsAgo)
NumPrices = UBound(PastPriceList,2)
For J =StartRow to StartRow+NumPrices
oSheet.GetCellByPosition(0, J).string=PastPriceList(0,J-StartRow) ' Symbol
oSheet.GetCellByPosition(1, J).value=PastPriceList(1,J-StartRow) ' Date
oSheet.GetCellByPosition(2, J).value=PastPriceList(2,J-StartRow) ' Price
Next J
StartRow=getLastUsedRow(oSheet)
Next I
' Format Date Column
NumRow=getLastUsedRow(oSheet)
oRange = oSheet.getCellRangeByPosition(1,0,1,NumRow)
FormatAsLocalDate(oRange)
' Store PastPrices
storeSheetCSV("D:/", "PastPrices")
MsgBox "Prices Saved"
' Close Document
GoToSheet("PastPrices")
thisComponent.close(true)
End Sub
Function PastPrices(Sym as String, NumberOfYearsAgo as Integer)
'http://www.oooforum.org/forum/viewtopic.phtml?t=4103
'http://www.oooforum.org/forum/viewtopic.phtml?t=16741
' Dims
Dim NumRow, I as Integer
Dim StartDay, StartMonth, StartYear as Integer
Dim cURL, oSheet, oCalcDoc
' Number Of Years Ago From Today to Start
StartDay=Day(Now())
StartYear=Year(Now())-(NumberOfYearsAgo)
StartMonth=Month(Now())-1 ' Yahoo adds a month, so subtract a month
If StartMonth= 0 then
StartMonth = 12
StartYear = StartYear-1
End If
' URL for historical stock prices
cURL ="http://ichart.finance.yahoo.com/table.csv?s=" & Sym & _
"&a=" & StartMonth & "&b=" & StartDay & "&c=" & StartYear & _
"&g=d&ignore=.csv"
' Open up a new spreadsheet from the above URL.
' Specify the CSV filter with options that decode the CSV format from Yahoo.
' Specify the Hidden property so that the spreadsheet does not appear.
oCalcDoc = StarDesktop.loadComponentFromURL( cURL, "_blank", 0, _
Array( MakePropertyValue( "FilterName", "Text - txt - csv (StarCalc)"), _
MakePropertyValue( "FilterOptions", _
"44,34,SYSTEM,1,1/10/2/10/3/10/4/10/5/10/6/10/7/10/8/10/9/10"), _
MakePropertyValue( "Hidden", True )))
' Get the first sheet of the Calc document and find number of rows
oSheet = oCalcDoc.getSheets().getByIndex(0)
NumRow=getLastUsedRow(oSheet)
' Create an array of the prices.
Dim PriceArray(3, NumRow )
For I =1 To NumRow
PriceArray(0, I-1 ) = Sym ' Symbol
PriceArray(1, I-1 ) = oSheet.getCellByPosition(0, I ).getValue() ' Date
PriceArray(2, I-1 ) = oSheet.getCellByPosition(4, I ).getValue() ' Price
Next I
oCalcDoc.close(True) 'Close the spreadsheet, since it is hidden
' Return the array of prices.
PastPrices = PriceArray()
End Function
Sub ImportCSVFile(sName$,fName$, Optional oDocument)
' http://www.oooforum.org/forum/viewtopic.phtml?t=22903
' Called by: ImportCSVFile("Prices", "d:/prices.csv", ThisComponent)
' Dims
Dim oDoc ' Calc document.
Dim oSheets ' The document sheets.
Dim oSheet ' A particular sheet.
' Sets
oDoc = IIF(IsMissing(oDocument), ThisComponent, oDocument)
If NOT oDoc.SupportsService("com.sun.star.sheet.SpreadsheetDocument") _
Then
Print "Sorry, the specified document is NOT a Calc document"
Exit Sub
End If
oSheets = oDoc.getSheets()
If oSheets.hasByName(sName) then
Print "Removing existing " & sName & " sheet"
oSheets.removeByName(sName)
End If
oSheets.insertNewByName(sName, oSheets.count())
oSheet = oSheets.getByIndex(oSheets.count()-1)
Dim sFilter$
Dim sOptions$
Dim sURL$
Dim s$
s = ""
sURL = "file:///" & fName$
sFilter = "Text - txt - csv (StarCalc)"
sOptions = "44,34,0,1,1/1/2/1"
oSheet.link(sURL, s, sFilter, sOptions, _
com.sun.star.sheet.SheetLinkMode.NORMAL)
oSheet.setLinkMode(com.sun.star.sheet.SheetLinkMode.NONE)
End Sub
Function getLastUsedRow(oSheet as Object) as Integer
' http://www.pitonyak.org/AndrewMacro.odt
Dim oCell As Object
Dim oCursor As Object
Dim aAddress As Variant
oCell = oSheet.GetCellbyPosition( 0, 0 )
oCursor = oSheet.createCursorByRange(oCell)
oCursor.GotoEndOfUsedArea(True)
aAddress = oCursor.RangeAddress
GetLastUsedRow = aAddress.EndRow
End Function
Sub DeleteSheet(SName as string)
If ThisComponent.Sheets.hasByName(SName) Then _
ThisComponent.Sheets.removeByName(SName)
End Sub
Sub NewOrReplaceSheet(SName as string)
' Dims
dim oDesktop as object
dim document as object
dim dispatcher as object
dim oSheets as object
dim oNewSheet as object
'
oDesktop = createUnoService("com.sun.star.frame.Desktop")
oDocument = ThisComponent
oSheets = oDocument.Sheets
If oSheets.hasByName(SName) Then oSheets.removeByName(SName)
oNewSheet = oDocument.createInstance("com.sun.star.sheet.Spreadsheet")
oSheets.insertByName(SName, oNewSheet)
End Sub
Sub FormatAsLocalDate (oRange as Object)
' http://www.oooforum.org/forum/viewtopic.phtml?t=4996
' Format the date cells as dates.
oFormats = ThisComponent.getNumberFormats()
oLocale = createUnoStruct( "com.sun.star.lang.Locale" )
nDateKey = oFormats.getStandardFormat( com.sun.star.util.NumberFormat.DATE, oLocale )
oRange.NumberFormat = nDateKey
End Sub
Sub storeSheetCSV (oDir as String, oSheet as String)
'http://www.oooforum.org/forum/viewtopic.phtml?t=23307
Dim mFileProperties(1) As New com.sun.star.beans.PropertyValue
ThisComponent.CurrentController.setActiveSheet(ThisComponent.sheets.getbyname(oSheet))
mFileProperties(0).Name = "FilterName"
mFileProperties(0).Value = "Text - txt - csv (StarCalc)"
mFileProperties(1).Name = "FilterOptions"
mFileProperties(1).Value = "44,34,ANSI"
ThisComponent.storeAsURL("file:///" & oDir & oSheet & ".csv", mFileProperties())
End Sub
Sub GoToSheet(oSheet As String)
thiscomponent.currentcontroller.setactivesheet _
(thisComponent.getsheets.getbyname(oSheet))
End Sub
Function MakePropertyValue( Optional cName As String, Optional uValue ) As com.sun.star.beans.PropertyValue
' Create and return a new com.sun.star.beans.PropertyValue.
' From http://www.oooforum.org/forum/viewtopic.phtml?t=5108
Dim oPropertyValue As New com.sun.star.beans.PropertyValue
If Not IsMissing( cName ) Then
oPropertyValue.Name = cName
EndIf
If Not IsMissing( uValue ) Then
oPropertyValue.Value = uValue
EndIf
MakePropertyValue() = oPropertyValue
End Function |
|
|
