I have a nice VBA script that allowed me to download stock ticker information from Yahoo into Excel.
Yahoo have recently changed their web interface and the download commands that used to work have now ceased to do so.
The previous commands had the following structure:-
"http://chart.finance.yahoo.com/table.csv?s=TSCO.L&a=5&b=09&c=2016&d=5&e=26&f=2016&g=d&ignore=.csv"
where the new commands look like:-
"https://query1.finance.yahoo.com/v7/finance/download/TSCO.L?period1=1465456200&period2=1466925000&interval=1d&events=history&crumb=Ns6veY6jrcA"
period1 & period2 are epoch representations of the date, and the 'crumb' I believe is unique to each machine that sends a download request to the yahoo server.
I think this remains the same for a reasonable period of time so it doesn't have to be changed.
If I paste the https request into a browser it works. However the routine that I used to check for the data's existence and to subsequently download the data no longer work.
This is a shortened version of the overall code, if anyone is so good as to try it out, you will probably have to replace my crumb value with your crumb value, this can be found if you follow this link:-
https://uk.finance.yahoo.com/quote/TSCO.L/history?p=TSCO.L and hover your mouse over the 'Download Data' link.
`Function IsResourceAvailable(strUrl As String) As Boolean
Dim objXhr As Object 'MSXML2.XMLHTTP60
Dim strStatus As String
Set objXhr = CreateObject("MSXML2.XMLHTTP") 'New XMLHTTP60
With objXhr
.Open "GET", strUrl, False
.send
strStatus = .Status
End With
'HTTP response of 200 = OK
IsResourceAvailable = (strStatus = "200")
End Function'
'Sub dloadDebug()
Dim strUrl As String
Dim blnAvailable As Boolean
strUrl = "https://query1.finance.yahoo.com/v7/finance/download/TSCO.L?period1=1465456200&period2=1466925000&interval=1d&events=history&crumb=Ns6veY6jrcA"
blnAvailable = IsResourceAvailable(strUrl)
Workbooks.Open Filename:=(strUrl)
End Sub`
Neither of the above now work, can anybody point me in the right direction please?
many thanks
GLW
Related
I have been using the following Excel VBA macro to bring back data from a website. It worked fine until a few days ago when the website stopped supporting IE. Of course the macro just fails now as there is no data on the webpage to bring back to Excel, Is there a way to have the "Get method" (MSXML2.XMLHTTP)
here is my Code
Public Sub GGGG()
Dim MSX As Object
Dim HTML As HTMLDocument
Dim URL As String
Dim UrlResponse As String
Dim N As Long
Dim sht1, sht2 As Worksheet
' On Error Resume Next
Set MSX = CreateObject("MSXML2.XMLHTTP")
Set HTML = New HTMLDocument
URL = "https://www.justdial.com/Agra/Yogi-General-Store-Opp-Eclave-Satiudum-Sadar-Bazaar/0562P5612-5612-120207212812-H5I2_BZDET"
With MSX
.Open "GET", URL, False
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.send
UrlResponse = StrConv(.responseBody, vbUnicode)
End With
ActiveCell.Offset(0, 1) = UrlResponse
End Sub
I get response like
Error
An error occurred while processing your request.
Reference #97.ec8a2c31.1621136928.281f3ca8
Please anyone can support me how to get data when IE dose not support
I am not an expert in coding
Okay, try this to get the title and votes from that site using vba in combination with selenium.
Sub FetchInfo()
Dim driver As Object, oTitle As Object
Dim oVotes As Object
Set driver = CreateObject("Selenium.ChromeDriver")
driver.get "https://www.justdial.com/Agra/Yogi-General-Store-Opp-Eclave-Satiudum-Sadar-Bazaar/0562P5612-5612-120207212812-H5I2_BZDET"
Set oTitle = driver.FindElementByCss("span.item > span", Raise:=False, timeout:=10000)
Set oVotes = driver.FindElementByCss("span.rtngsval > span.votes", Raise:=False, timeout:=10000)
Debug.Print oTitle.Text, oVotes.Text
End Sub
When the webpage no longer support IE in future, you can try out web scrape using Google Chrome with new add-in installed, please see following link for the add-in installation adn how to write in VBA. However, it is in my opinion the most simple way to perform your work is to use Uipath free community version, it work for all type of web-browser.
VBA guideline:
https://www.wiseowl.co.uk/vba-macros/videos/vba-scrape-websites/web-scraping-selenium-chrome/
VBA library installation for Selenium:
https://code.google.com/archive/p/selenium-vba/downloads
You probably need to set the Feature Browser Emulation to zero as detailed by Daniel here:
Everything You Never Wanted to Know About the Access WebBrowser Control
That said, your URL fails even when opened in Edge Chromium, so the site may suffer from a general failure.
I have been using the following Excel VBA macro to bring back data from a website. It worked fine until a few days ago when the website stopped supporting IE. Of course the macro just fails now as there is no data on the webpage to bring back to Excel, just a message saying, "Your browser, Internet Explorer, is no longer supported." Is there a way to have the "Get method" (MSXML2.XMLHTTP) use Chrome instead of IE to interact with the website? BTW, my default browser is already set to "Chrome".
Dim html_doc As HTMLDocument ' note: reference to Microsoft HTML Object Library must be set
Sub KS()
' Define product url
KS_url = "https://www.kingsoopers.com/p/r-w-knudsen-just-blueberry-juice/0007468210784"
' Collect data
Set html_doc = New HTMLDocument
Set xml_obj = CreateObject("MSXML2.XMLHTTP")
xml_obj.Open "GET", KS_url, False
xml_obj.send
html_doc.body.innerHTML = xml_obj.responseText
Set xml_obj = Nothing
KS_product = html_doc.getElementsByClassName("ProductDetails-header")(0).innerText
KS_price = "$" & html_doc.getElementsByClassName("kds-Price kds-Price--alternate mb-8")(1).Value
do Stuff
End Sub
The check for this is a basic server check on user agent. Tell it what it wants to "hear" by passing a supported browser in the UA header...(or technically, in this case, just saying the equivalent of: "Hi, I am not Internet Explorer".)
It can be as simple as xml.setRequestHeader "User-Agent", "Chrome". I said basic because you could even pass xml.setRequestHeader "User-Agent", "I am a unicorn", so it is likely an exclusion based list on the server for Internet Explorer.
Option Explicit
Public Sub KS()
Dim url As String
url = "https://www.kingsoopers.com/p/r-w-knudsen-just-blueberry-juice/0007468210784"
Dim html As MSHTML.HTMLDocument, xml As Object
Set html = New MSHTML.HTMLDocument
Set xml = CreateObject("MSXML2.XMLHTTP")
xml.Open "GET", url, False
xml.setRequestHeader "User-Agent", "Mozilla/5.0"
xml.send
html.body.innerHTML = xml.responseText
Debug.Print html.getElementsByClassName("ProductDetails-header")(0).innerText
Debug.Print "$" & html.getElementsByClassName("kds-Price kds-Price--alternate mb-8")(1).Value
Stop
End Sub
Compare that with adding no UA or adding xml.setRequestHeader "User-Agent", "MSIE".
Study the article here by Daniel Pineault and this paragraph:
Feature Browser Emulation
Also note my comment dated 2020-09-13.
I am trying to bring into vba the data displayed under the -Dividend Summary- title of this webpage:
https://seekingalpha.com/symbol/ABBV/dividends/scorecard
By running this line of code in the Google Chrome console I managed to get the info, so I am trying to replicate this in VBA.
document.querySelectorAll("div [data-test-id='dynamic-tooltips-area']")[1].innerText
The VBA code I have written is this:
Public Sub Stackoverflow_Question()
Dim sResponse As String, i As Long, Html As New HTMLDocument
Dim oSelectors As MSHTML.IHTMLDOMChildrenCollection 'Object
'Get response from webpage
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "https://seekingalpha.com/symbol/ABBV/dividends/scorecard", False
.send
sResponse = .responseText
End With
'Write and read HTML
With Html
.body.innerHTML = sResponse
Set oSelectors = .querySelectorAll("div [data-test-id='dynamic-tooltips-area']")
End With
'Print obtained data -this produces no result-
'I loop only to be sure that I don't request the wrong index
For i = 0 To oSelectors.Length - 1
Debug.Print oSelectors(i).innerText
Next i
'Auxiliary: Create txt with response text
Dim FilePath As String
Dim TextFile As Integer
FilePath = Application.ActiveWorkbook.Path & "\HTML_ResponseText.txt"
TextFile = FreeFile
Open FilePath For Output As TextFile
Print #TextFile, sResponse
Close TextFile
End Sub
Not only do I get no result from the debug.print, but a simple search in the responseText string shows that contents from the webpage such as the header "Div Yield (FWD)" or the values (4.99% as of today) are not there.
Why is the .ResponseText not working as I expect?
Is there and alternative way to retrieve the webpage content as text?
Thank you in advance
As pointed out by Tim Williams, loading a webpage usually takes more than one request.
In Google Chrome, pressing F12 and going to the "Network" tab shows all of them, as well as their respective Request URL's.
Looking for the wanted one looks like a trial and error task, but it all seems to be there.
In my case, the URL I was interested in is:
https://seekingalpha.com/api/v3/symbol_data?fields[]=divYieldFwd&fields[]=divRate&fields[]=payoutRatio&fields[]=divGrowRate5&fields[]=dividendGrowth&fields[]=divDistribution&fields[]=dividends&slugs=ABBV
Request your help to solve the below issue,I am struck for two days,
vba run time error '- 2146697208 (800c0008 )': The download of the specified resource has failed
This is my code for your reference:
Sub telebot15status155555()
'Program Excel Messeger
' Purpose : Send Message to Telegram
' Author : John Eswin Nizar
' Date : 09 October 2017
Dim objRequest As Object
Dim strChatId As String
Dim strMessage1 As String
Dim strMessage2 As String
Dim strPostData As String
Dim strResponse As String
strChatId = "#messstatus"
strMessage1 = ""
strMessage2 = Now()
'strMessage = "hallo"
strPostData = "chat_id=" & strChatId & "&text=" & strMessage1 & strMessage2
Set objRequest = CreateObject("MSXML2.XMLHTTP")
With objRequest
.Open "POST", "https://api.telegram.org/sendMessage?", False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.send (strPostData)
GetSessionId = .responseText
MsgBox GetSessionId
End With
End Sub
My advice here is to perform this API call in Chrome with DevTools open. Or access the page, where this happens, and find the Request on the 'Network' tab. Then look at the headers.
debug.print strPostData is returning:
chat_id=#messstatus&text=2/7/2020 9:40:23 AM
That format does not look correct for an API that is form-urlencoded. You need to see what the website is actually sending and receiving in the DevTools in order to replicate it.
IOW, The resource isn't found because the API is incorrectly formatted. From the base api, it looks like its actually a QueryString too because it ends with ? which might mean you have to url-encode format the POST Data into the QueryString for the main HTTP request. Have a look here: Pass Parameters in VBA HTTP Post Request
I have a HTML web page at work that I want to query data from tables into excel 2007. This web page requires I sign on with a password. I sign in with my normal IE7 browser, then I go to DATA -> connections -> my connections and edit the query. This reads the IE7 cookie cache and I re-POST the data to connect to the server's security by clicking "retry" when it says "the web query returned no data". After I do this, the data imports fine.
I can do this just fine and it only needs to be done once a day. Other users of my application find this difficult which leads to my question:
Is there a way to automatically POST this data back with VB? I'm thinking maybe I should use the cookie property of the IE.Document.cookie?
I'm calling the following login script, before I continue with the web query (set reference to XML library). Look around to find some instructions how you can find your POST parameters.
Sub XMLHttpLogin()
Dim i As Integer
Dim sExpr As String
Dim sPar As String, sURL as String
Dim sResp As String
Dim XMLHttp As MSXML2.XMLHTTP60
Set XMLHttp = New MSXML2.XMLHTTP60
sPar = "name=user1&pass=pass1&form_id=form1" 'The parameters to send.
sURL = "http://www.stackoverflow.com"
With XMLHttp
.Open "POST", sURL, True 'Needs asynchronous connection
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.send (sPar)
i = 0 'wait until data has been downloaded
Do While i = 0
If .readyState = 4 Then
If .Status = 200 Then Exit Do
End If
DoEvents
Loop
sResp = .responseText 'contains source code of website
sExpr = "not-logged-in" 'look for this string in source code
If InStr(1, sResp, sExpr, vbTextCompare) Then
MsgBox "Not logged in. Error in XMLHttpLogin"
End If
End With
End Sub