Forum at OOoForum.orgThe Forum
 [Home]   [FAQ]   [Search]   [Memberlist]   [Usergroups]   [Register
 [Profile]   [Log in to check your private messages]   [Log in

Downloading Historical Stock Prices

Post new topic   Reply to topic Forum Index -> Code Snippets
View previous topic :: View next topic  
Author Message
General User
General User

Joined: 25 Jan 2006
Posts: 17

PostPosted: Tue Feb 14, 2006 2:23 pm    Post subject: Downloading Historical Stock Prices Reply with quote

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"

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")
 Dim Sym(NumRow)
 For I = 0 to NumRow
     Sym(I) = oSheet.GetCellByPosition(0,I).string
 Next I
' Add a Sheet for PastPricesList
 oSheet = ThisComponent.getSheets().getByName("PastPrices")
' Go Through Sym Array and download past prices starting on StartDate
 For I = LBound(Sym()) to UBound(Sym())
     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
 Next I
' Format Date Column
 oRange = oSheet.getCellRangeByPosition(1,0,1,NumRow)
' Store PastPrices
  storeSheetCSV("D:/", "PastPrices")
 MsgBox "Prices Saved"
' Close Document
End Sub

Function PastPrices(Sym as String, NumberOfYearsAgo as Integer)
' Dims
 Dim NumRow, I as Integer
 Dim StartDay, StartMonth, StartYear as Integer
 Dim cURL, oSheet, oCalcDoc
' Number Of Years Ago From Today to Start
 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 ="" & Sym & _
     "&a=" & StartMonth & "&b=" & StartDay & "&c=" & StartYear & _
' 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)
' 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)
' 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("") _
    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"
  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", s, sFilter, sOptions, _
End Sub

Function getLastUsedRow(oSheet as Object) as Integer
  Dim oCell As Object
  Dim oCursor As Object
  Dim aAddress As Variant
  oCell = oSheet.GetCellbyPosition( 0, 0 )
  oCursor = oSheet.createCursorByRange(oCell)
  aAddress = oCursor.RangeAddress
  GetLastUsedRow = aAddress.EndRow
End Function

Sub DeleteSheet(SName as string)
 If ThisComponent.Sheets.hasByName(SName) Then _
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("")
 oDocument = ThisComponent
 oSheets = oDocument.Sheets
 If oSheets.hasByName(SName) Then oSheets.removeByName(SName)
 oNewSheet = oDocument.createInstance("")
 oSheets.insertByName(SName, oNewSheet)
End Sub

Sub FormatAsLocalDate (oRange as Object)
' Format the date cells as dates.
 oFormats = ThisComponent.getNumberFormats()
 oLocale = createUnoStruct( "" )
 nDateKey = oFormats.getStandardFormat(, oLocale )
 oRange.NumberFormat = nDateKey
End Sub

Sub storeSheetCSV (oDir as String, oSheet as String)
 Dim mFileProperties(1) As New
 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 _
End Sub

Function MakePropertyValue( Optional cName As String, Optional uValue ) As
' Create and return a new
' From
   Dim oPropertyValue As New
   If Not IsMissing( cName ) Then
      oPropertyValue.Name = cName
   If Not IsMissing( uValue ) Then
      oPropertyValue.Value = uValue
   MakePropertyValue() = oPropertyValue
End Function
Back to top
View user's profile Send private message

Joined: 18 Nov 2011
Posts: 1

PostPosted: Fri Nov 18, 2011 8:10 am    Post subject: Error Message Reply with quote

Getting a basic syntax error for the following line of code:

' URL for historical stock prices
cURL ="" & Sym & _
"&a=" & StartMonth & "&b=" & StartDay & "&c=" & StartYear & _

Help..I do not know how to code and I am trying to learn. Thank you
Back to top
View user's profile Send private message

Joined: 15 Jul 2013
Posts: 2

PostPosted: Mon Jul 15, 2013 9:37 pm    Post subject: Reply with quote

This good code and help in technical coding of the HTML .
plagerize checker
Back to top
View user's profile Send private message Yahoo Messenger
Display posts from previous:   
Post new topic   Reply to topic Forum Index -> Code Snippets All times are GMT - 8 Hours
Page 1 of 1

Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum

Powered by phpBB © 2001, 2005 phpBB Group