The following macro downloads data (prices, volume…) from Yahoo Finance for a given stock and a range of dates. The steps are:
Sub main()
Dim dirlocal As String
Dim ticker As String
Dim date1 As Long, date2 As Long
'Path of the folder I want to download the data in
dirlocal = Application.ActiveWorkbook.path
ticker = "KO" 'The CocaCola Company
date1 = 43831 '01/01/2020
date2 = 43861 '31/01/2020
Call download_CSV(dirlocal, ticker, date1, date2)
End Sub
Sub download_CSV(dirlocal As String, ticker As String, date1 As Long, date2 As Long)
'Create excel file that will contain the downloaded data
Dim Dir_xls As StringIT
Dir_xls = dirlocal & "\" & ticker & ".xlsx"
Dim wb As Workbook
Set wb = Workbooks.Add
wb.SaveAs Dir_xls
'DOWNLOAD DATA. -1- Compose URL
Dim URL As String
Dim dat1 As Long, dat2 As Long
'I need to "scale" the dates for the web page to understand me:
dat1 = (date1 - 25569) * 86400
dat2 = (date2 - 25569) * 86400
URL = "https://query1.finance.yahoo.com/v7/finance/download/" & ticker & "?period1=" & dat1 & "&period2=" & dat2 & "&interval=1d&events=history"
'DOWNLOAD DATA. -2- Save csv
Dim Dir_csv As String
Dir_csv = dirlocal & "\" & ticker & ".csv"
Dim WinHttpReq As Object
Dim ostream As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", URL, False
WinHttpReq.send
If WinHttpReq.Status = 200 Then
Set ostream = CreateObject("ADODB.Stream")
ostream.Open
ostream.Type = 1
ostream.Write WinHttpReq.responseBody
ostream.SaveToFile Dir_csv, 2
ostream.Close
Else
MsgBox (WinHttpReq.Status & " : Not found")
End If
'DOWNLOAD DATA. -3- Import csv
Dim strText As String
'Read utf-8 file to strText variable
With CreateObject("ADODB.Stream")
.Open
.Type = 1 ' Private Const adTypeBinary = 1
.LoadFromFile Dir_csv
.Type = 2 ' Private Const adTypeText = 2
.Charset = "utf-8"
strText = .ReadText(-1) ' Private Const adReadAll = -1
End With
'DOWNLOAD DATA. -4- Parse strText to worksheet
Dim ws As Worksheet 'Worksheet I want to place the data in
Set ws = wb.Worksheets(1)
Dim introw As Long
Dim strLine As Variant
introw = 1
Application.DisplayAlerts = False
For Each strLine In Split(strText, Chr(10))
If strLine <> "" Then
With ws
.Cells(introw, 1) = strLine
.Cells(introw, 1).TextToColumns Destination:=Cells(introw, 1), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False
End With
'Ignore line if price is "null"
If ws.Cells(introw, 5) <> "null" Then
introw = introw + 1
End If
End If
Next strLine
'Delete csv file
Kill Dir_csv
'Save excel file
wb.Save
wb.Close
End Sub
I am not familiar with the "Microsoft.XMLHTTP" and "ADODB.Stream" objects. I managed to make the macro work by looking on the internet.
I was wondering if, for the sake of simplicity -and maybe efficiency- it would be possible to skip saving the csv and instead downloading the string right away, so I tried merging the steps 2 and 3 into this:
'DOWNLOAD DATA. -2&3- Get String
Dim strText As String 'Aimed string
Dim WinHttpReq As Object
Dim ostream As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", URL, False
WinHttpReq.send
If WinHttpReq.Status = 200 Then
Set ostream = CreateObject("ADODB.Stream")
With ostream
.Open
.Write WinHttpReq.responseBody
.Type = 2 ' Private Const adTypeText = 2
.Charset = "utf-8"
strText = .ReadText(-1) ' Private Const adReadAll = -1
End With
Else
MsgBox (WinHttpReq.Status & " : Not found")
End If
I get the error
Operation not allowed in this context
in this line
.Write WinHttpReq.responseBody
Is it possible to skip saving, importing and deleting the csv file?
If so, how?
Thanks in advance.
Update
I solved it with this code. I will have to check if it actually runs faster. Also I am missing things such as specifying the character typoe (utf-8), but it seems to be working in this case.
'DOWNLOAD DATA. -2&3- Get String
Dim strText As String 'Aimed string
Dim WinHttpReq As Object
Dim ostream As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", URL, False
WinHttpReq.send
If WinHttpReq.Status = 200 Then
strText = WinHttpReq.responseText
Else
MsgBox (WinHttpReq.Status & " : Not found")
End If
You can open the csv directly in excel using the URL:
Dim URL, wb
URL = "https://query1.finance.yahoo.com/v7/finance/download/AAPL?" & _
"period1=1592352000&period2=1596672000&interval=1d&events=history"
Set wb = Workbooks.Open(URL)
The importing of the CSV data could be done with Power Query.
This will execute without saving the CSV.
And to execute this with VBA, just record the macro while performing the steps above and you'll have the code needed to reproduce this in VBA.
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.