PDA

View Full Version : [SOLVED] Importing share price data (open, high, low, close & volume) from website



Lee2014
05-03-2014, 10:04 PM
Hi,

Thanks in advance for your assistance, I appreciate it.

I have a macro which fetches the closing (last) price of an Australian share and it functions very well.

I would like to create an additional 4 macros that fetch the opening price, high of the day, low of the day and volume for the day.

I am struggling to do this myself because the HTML from the ASX website presents the "close" data in a different way to the open, high, low & volume data. Unfortunately I cannot post a link to the ASX website but if you google "ASX WOW" it will take you to the Woolworths page on the ASX website.

Here is the code I currently have:
Public Function close_price(code As String)
html_source = ShowHTML(code)
checkval = "<td class=""last"">"
pos_check = InStr(1, html_source, checkval, vbTextCompare) + Len(checkval)
Length = Len(html_source) - pos_check + 1
html_source = Right(html_source, Length)
pos_end = InStr(1, html_source, "</td>", vbTextCompare) - 1
htm = Left(html_source, pos_end)
If IsNumeric(htm) Then
htm = CDbl(htm)
Else
htm = "N/A"
End If
close_price = htm
End Function

Private Function ShowHTML(code As String)
strURL = "WEBSITE URL GOES HERE, I CANT POST A URL TO THIS FORUM" & code
strError = ""
Dim oXMLHTTP As MSXML2.XMLHTTP
Set oXMLHTTP = New MSXML2.XMLHTTP
strResponse = ""
With oXMLHTTP
.Open "POST", strURL, False
.send ""
strResponse = .responseText
End With
ShowHTML = strResponse
End Function

Here is an extract of the HTML code from the ASX website where it presents all the data I need:



<td class="last">36.600</td>



<td style="white-space: nowrap;" class="change indicator">0.22%</td>



<td>36.550</td>



<td>36.600</td>



<td>36.600</td>



<td>36.800</td>



<td>36.400</td>



<td>2,357,945</td>

The red lines above are bid, offer, open, high, low and volume (in that order). The blue line is the closing/last price.

I get the "last" price by searching for "<td class="last">" however this obviously won't work for the others because they are prefixed with a very generic string "<td>".

I hope you understand my problem, it was very difficult to articulate.

Thanks so much!

snb
05-04-2014, 03:26 AM
Sub M_snb()
ActiveSheet.QueryTables.Add("URL;http://www.asx.com.au/asx/markets/equityPrices.do?asxCodes=WOW&by=asxCodes", Range("$A$1")).Refresh False
End sub

or


Sub M_snb()
ActiveSheet.QueryTables.Add("URL;https://www.google.com/finance/historical?q=ASX:WOW&ei=nxNmU6CZAu3EwAPZJQ#", Range("$A$10")).Refresh False
End Sub

Lee2014
05-04-2014, 05:50 AM
WOW!! Mind = blown...

Is it possible for you to explain to me how one line of code did all that?

I actually came up with another fix but this is much cleaner.....

Thanks so much!

p45cal
05-04-2014, 06:31 AM
I would like to create an additional 4 macros that fetch the opening price, high of the day, low of the day and volume for the day.
Well, I haven't quite done that (I didn't read your message fully before getting into the nitty gritty), instead I wrote a udf to get you the following 7 prices:
Last Bid Offer Open High Low Volume
It gets all 7 values in one visit to the site and you can see them all on a sheet in a horizontal row if you array-enter (Ctrl+Shift+Enter, not just Enter) the formula all at once in a range of cells 1 row high and 7 columns wide.
If you need them vertically I can tweak the macro or you can use TRANSPOSE.
Using 4 different UDFs (macros) will take about 4 times as long.
I also didn't read or follow your instructions on how to get to the site via Google, as a consequence I used a different web page of the Asx site to get the data from, so I have written 2 udfs, one to get data from the page you suggested (ThePrices) and one called ThePrices2 which uses the equityPrices page which is a little easier to get the data from rather than the companyInfo page. There is documentation among the comments in the code.
You only need one of these two udfs.
If you want the Open alone you can use the likes of (you don't need to array-enter these):
=INDEX(ThePrices(D13),4)
where D13 contains the company symbol, or use the company symbol in the formula if you wish:
=INDEX(ThePrices("WOW"),4)
For the high, low and volume you'd change the 4 to 5, 6 and 7 respectively.
If you want, I/you could tweak the udf to output only the 4 values you want. This would be quicker than fetching those 4 values with 4 separate INDEX formulae.
Here's the code and I've attached a sample workbook.
Public Function ThePrices(code As String)
'use with http://www.asx.com.au/asx/research/companyInfo.do?by=asxCode&asxCode= in the ShowHTML function
Dim myPrices(0 To 6)
html_source = ShowHTML(code)
checkval = "<td class=""last"">"
html_source = Split(html_source, checkval)(1)
html_source = Left(html_source, 600) 'temporary line, needs refining.
html_source = Application.Trim(Application.Clean(html_source))
yyy = Split(html_source, "</td> <td>")
yyy(0) = Split(yyy(0), "</td>")(0)
yyy(6) = Split(yyy(6), "</td>")(0)
For i = 0 To 6
If IsNumeric(yyy(i)) Then myPrices(i) = CDbl(yyy(i)) Else myPrices(i) = "N/A"
Next i
ThePrices = myPrices
End Function


Private Function ShowHTML(code As String)
'strURL = "http://www.asx.com.au/asx/markets/equityPrices.do?by=asxCodes&asxCodes=" & code 'use with ThePrices2
strURL = "http://www.asx.com.au/asx/research/companyInfo.do?by=asxCode&asxCode=" & code 'use with ThePrices
strError = ""
Dim oXMLHTTP As MSXML2.XMLHTTP
Set oXMLHTTP = New MSXML2.XMLHTTP
strResponse = ""
With oXMLHTTP
.Open "POST", strURL, False
.send ""
strResponse = .responseText
End With
ShowHTML = strResponse
End Function


Public Function ThePrices2(code As String)
'use with http://www.asx.com.au/asx/markets/equityPrices.do?by=asxCodes&asxCodes= in the ShowHTML function
Dim myPrices(0 To 6)
html_source = ShowHTML(code)
checkval = "<td class=""last"">"
html_source = Split(html_source, checkval)(1)
html_source = Left(html_source, 500) 'temporary line, needs refining.
html_source = Application.Clean(html_source)
yyy = Split(html_source, "</td><td>")
yyy(0) = Split(yyy(0), "</td>")(0)
yyy(6) = Split(yyy(6), "</td>")(0)
For i = 0 To 6
If IsNumeric(yyy(i)) Then myPrices(i) = CDbl(yyy(i)) Else myPrices(i) = "N/A"
Next i
ThePrices2 = myPrices
End Function

snb
05-04-2014, 06:57 AM
1. first explore Excel's built in facilities
2. use the macrorecorder
3. reduce the code to the minimum by commenting out each recorded VBA line line by line
4. a querytable has a link to the website; it can be updated/refreshed as often as you like
5. your code does the trick only once: it's static.

pike
05-04-2014, 01:31 PM
or with out importing all the Internet controls
Option Explicit
Sub Web_Table_Option_One()
Dim xml As Object
Dim html As Object
Dim objTable As Object
Dim result As String
Dim lRow As Long
Dim lngTable As Long
Dim lngRow As Long
Dim lngCol As Long
Dim ActRw As Long
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
With xml
.Open "GET", "http://www.asx.com.au/asx/markets/equityPrices.do?asxCodes=WOW&by=asxCodes", False
'or
'.Open "GET", "https://www.google.com/finance/historical?q=ASX:WOW&ei=nxNmU6CZAu3EwAPZJQ#", False
.send
End With
result = xml.responseText
Set html = CreateObject("htmlfile")
html.body.innerHTML = result
Set objTable = html.getElementsByTagName("table")
For lngTable = 0 To objTable.Length - 1
For lngRow = 0 To objTable(lngTable).Rows.Length - 1
For lngCol = 0 To objTable(lngTable).Rows(lngRow).Cells.Length - 1
ThisWorkbook.Sheets("Sheet2").Cells(ActRw + lngRow + 1, lngCol + 1) = objTable(lngTable).Rows(lngRow).Cells(lngCol).innerText
Next lngCol
Next lngRow
ActRw = ActRw + objTable(lngTable).Rows.Length + 1
Next lngTable
End Sub