This is a VBA function that I cannot get to work. The original code downloads stock quotes for only one stock ticker at a time. I am trying to adapt it to cycle through a table of stock symbols. Using the start and ending dates for requested data, the function is to loop through a table of ticker symbols and download all historical data for each symbol within that date range. Ultimately I would like to export this data into three different formats with csv to start with. See attached file for sample outputs.
Code:
Public Function HistoricalQuotes(StartDate As String, EndDate As String)
On Error GoTo Whoops
'Parameters for date range
Dim StartMonth, StartDay, StartYear As String
Dim EndMonth, EndDay, EndYear As String
'Parameters for recordset
Dim db As DAO.Database, tblDef As DAO.TableDef
Dim qdf As DAO.QueryDef, prm As DAO.Parameter
Dim strSQL As String, rst As DAO.Recordset
'Parameters for web data
Dim XMLHTTP As Object, byteData() As Byte
'Other parameters
Dim DownloadURL As String
Dim strTargetPath As String, strFileName As String, strFilePath As String
Dim strTable As String, strSymbol As String
Dim FileNumber As Integer
StartMonth = Format(Month(StartDate) - 1, "00")
StartDay = Format(Day(StartDate), "00")
StartYear = Format(Year(StartDate), "00")
EndMonth = Format(Month(EndDate) - 1, "00")
EndDay = Format(Day(EndDate), "00")
EndYear = Format(Year(EndDate), "00")
' ******* Start Symbol Loop
Set db = CurrentDb()
strSQL = "SELECT tblSymbols.Symbol FROM tblSymbols;"
Set rst = db.OpenRecordset(strSQL)
rst.MoveFirst
Do Until rst.EOF
strSymbol = rst![Symbol]
'Debug.Print strSymbol
DownloadURL = "http://ichart.finance.yahoo.com/table.csv?" & _
"s=" & strSymbol & _
"&a=" & StartMonth & _
"&b=" & StartDay & _
"&c=" & StartYear & _
"&d=" & EndMonth & _
"&e=" & EndDay & _
"&f=" & EndYear & _
"&g=d&ignore=.csv"
' Retrieve the file from the specified URL
Set XMLHTTP = CreateObject("MSXML2.ServerXMLHTTP")
XMLHTTP.Open "GET", DownloadURL, False
XMLHTTP.Send
byteData = XMLHTTP.responseBody
Set XMLHTTP = Nothing
'Write data to Symbol CSV file
strTargetPath = CurrentDir()
strFileName = strSymbol
strFilePath = strTargetPath & strFileName
FileNumber = FreeFile ' Get unused file number.
Open strFilePath & ".csv" For Binary Access Write As #FileNumber
Put #FileNumber, , byteData ' Output text.
Close #FileNumber ' Close file.
'Move to the next record
rst.MoveNext
Loop
'Close the target recordset
rst.Close
'Clear the instances of the recordsets
Set rst = Nothing
db.Close
Set db = Nothing
' ******* End Symbol Loop
MsgBox "Download Completed." & vbCrLf & "Open " & strTargetPath & " to view files ?", vbYesNo
OffRamp:
Exit Function
Whoops:
MsgBox "Error #" & Err & ": " & Err.Description
Resume OffRamp
End Function
1. Change the Function to a Sub, put the database and looping code in a separate subroutine which calls HistoricalQuotes for each symbol - therefore add an extra parameter for the symbol.
2. Get rid of the error handling code - why are you using it? Instead, write code which anticipates potential errors and only use On Error if absolutely necessary and document exactly why it is being used.
3. In this statement:
Code:
Dim StartMonth, StartDay, StartYear As String
StartMonth and StartDay are being declared as Variants; only StartYear is a string To declare them all as Strings, the line should be:
Code:
Dim StartMonth As String, StartDay As String, StartYear As String
4. Your code is VBA, not VBScript, so this post should really go in the Office forum.
Reply With Quote
Originally Posted by His Nibbs
