Returning a Share Price from Google

[MartinS]

Hi
I've done lots of googling on this, and each time I think I've found a solution, it sets off a new issue, so thought I'd ask the experts and see what I'm doing wrong.
I'm trying to write a function to return the share price for a specific company to display in a workbook (only for reference), but whilst I have found several solutions online, and getting past the initial access denied issue, I'm now seeing an error saying "The date in the certificate is invalid or has expired". As you can see from the code, I did find what appeared to be a solution by telling the request to ignore errors, but still seeing the same error.

Function GetSharePrice(strSearchQuery As String) As Double

Dim strUrl As String
Dim strContent As String
Dim strSearchText As String
Dim strSharePrice As String

'strUrl = "https://finance.google.com/finance?q=" & strSearchQuery
strUrl = "https://www.google.com/search?q=" & strSearchQuery & "&tbm=fin"

Const SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS As Long = 13056
Const SXH_SERVER_CERT_IGNORE_CERT_DATE_INVALID As Long = 8192

With CreateObject("MSXML2.ServerXMLHTTP.6.0")
.Open "GET", strUrl, False
.setOption(2) = .getOption(2) - SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS
.send
strContent = .responseText
End With

strSearchText = "itemprop=""price"""
strSharePrice = Mid(strContent, InStr(1, strContent, strSearchText) + Len(strSearchText) + 6)
GetSharePrice = Left(strSharePrice, InStr(strSharePrice, """") - 1)

End Function

I'm ignoring the last couple of lines at the moment as can't get the response to then determine what to search for, it's getting the response text that I need help with.
The only way this will kind of work is to change the line:
.setOption(2) = .getOption(2) - SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS
to
.setOption(2) = SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS
BUT this returns a simple request with Access Denied as the only content.

So the example function call would be GetSharePrice("aapl+shareprice"), which as a url (https://www.google.com/search?q=aapl+shareprice&tbm=fin) works without issue in the browser.

Is it possible to return a value from a webpage like this?

Many thanks

Martin

 

[igold]

You may want to take a different approach...

I have created a public google spreadsheet which consists of my symbol list and the info I wish to return using the built-in google finance functions (i.e. Last, change, previous, etc.). Since it is public you can then import it as a CSV and parse it as you see fit. My basic code looks like this...

    Dim w As Worksheet: Set w = ActiveSheet
    Dim i As Long
    Dim last As Integer: last = w.Range("D3").End(xlDown).Row
    Dim url As String: url = "https://docs.google.com/spreadsheets/d/e/************************/pub?output=csv"
    Dim http As New WinHttpRequest
    http.Open "GET", url, False
    http.Send
    Dim resp As String: resp = http.ResponseText
    Dim Lines As Variant: Lines = Split(resp, vbNewLine)
    Dim sLine As String
    Dim Values As Variant, DivsP As Variant
    Dim DivsD As Single
    For i = 1 To UBound(Lines)
        sLine = Lines(i)
        If InStr(sLine, ",") > 0 Then
            Values = Split(sLine, ",")
            w.Cells(i + 1, 1).Value = Values(0)   'Symbol
            w.Cells(i + 1, 4).Value = Values(1)   'Last
            w.Cells(i + 1, 21).Value = Values(10)   'Target Price
            w.Cells(i + 1, 25).Value = Values(9)   'Dividend
            w.Cells(i + 1, 8).Value = Values(4)   'Previous Price
        End If
    Next

As an aside, I would think that after 400+ posts you would be using code tags!!

 

[alansidman]

Look at this link. This is what I use.

https://appsource.microsoft.com/en-...3e74-8e09-4b0f-bf47-a8992c45e781&referralurl=

 

[MartinS]

You may want to take a different approach...

I have created a public google spreadsheet which consists of my symbol list and the info I wish to return using the built-in google finance functions (i.e. Last, change, previous, etc.). Since it is public you can then import it as a CSV and parse it as you see fit. My basic code looks like this...

    Dim w As Worksheet: Set w = ActiveSheet
    Dim i As Long
    Dim last As Integer: last = w.Range("D3").End(xlDown).Row
    Dim url As String: url = "https://docs.google.com/spreadsheets/d/e/************************/pub?output=csv"
    Dim http As New WinHttpRequest
    http.Open "GET", url, False
    http.Send
    Dim resp As String: resp = http.ResponseText
    Dim Lines As Variant: Lines = Split(resp, vbNewLine)
    Dim sLine As String
    Dim Values As Variant, DivsP As Variant
    Dim DivsD As Single
    For i = 1 To UBound(Lines)
        sLine = Lines(i)
        If InStr(sLine, ",") > 0 Then
            Values = Split(sLine, ",")
            w.Cells(i + 1, 1).Value = Values(0)   'Symbol
            w.Cells(i + 1, 4).Value = Values(1)   'Last
            w.Cells(i + 1, 21).Value = Values(10)   'Target Price
            w.Cells(i + 1, 25).Value = Values(9)   'Dividend
            w.Cells(i + 1, 8).Value = Values(4)   'Previous Price
        End If
    Next

Thanks, though am still getting Date in the certificate error. If I pop the url into a browser, then our firewall blocks it, so am guessing that's the issue.

As an aside, I would think that after 400+ posts you would be using code tags!!

Yes, sorry, I forgot to add the tags, I'll make sure I do in future.

Thanks

Martin