Trying to extract ONE value from a webpage with VBA in Excel - excel

I've been trying to find the information now for a couple of days, but all the examples I've found just has a small piece of the code, I need it all =)
What I want to do is to extract one value from a homepage and put it into a cell in Excel
(and then take another value from another page on the same site and put in the next cell etc etc.)
The page is a swedish stock-exchange page, and the page I've used as a test-page is the stock for "Investor B" (https://www.avanza.se/aktier/om-aktien.html/5247/investor-b)
And the value I'm interested in is the one called "Senaste" (this is the page-information surrounding it)
<li>
<span class="XSText">Senast<br/></span>
<span class="lastPrice SText bold"><span class="pushBox roundCorners3" title="Senast uppdaterad: 17:29:59">248,60</span></span>
</li>
And it's the value 248,60 I'm after!
I got some coding experience, but not for VBA-scripting, after reading some forum-posts (mostly here), I've been trying out a few example by myself, but couldn't get any to work.
Since I'm quite basic with VBA, I might have got the structure wrong, so please be basic and patient with me, this was my test, but I got "Runtime error 429"
ActiveX component can't create object
I might be totally on the wrong track
Private Sub CommandButton1_Click()
Dim ie As Variant
Set ie = CreateObject("InternetExplorer")
ie.navigate "https://www.avanza.se/aktier/om-aktien.html/5247/investor-b"
ie.Visible = True
Do
DoEvents
Loop Until ie.readyState = READYSTATE_COMPLETE
Application.Wait (Now() + TimeValue("00:00:016")) ' For internal page refresh or loading
Dim doc As Variant 'variable for document or data which need to be extracted out of webpage
Set doc = CreateObject("HTMLDocument")
Set doc = ie.document
Dim dd As Variant
dd = doc.getElementsByClassName("lastPrice SText bold")(0).innerText
MsgBox dd
End Sub
EDIT: 2014-05-12 Current code beeing tested 17:05
under the button command
Private Sub CommandButton1_Click()
Dim IE As Object
' Create InternetExplorer Object
Set IE = CreateObject("InternetExplorer.Application")
' You can uncoment Next line To see form results
IE.Visible = False
' Send the form data To URL As POST binary request
IE.Navigate "https://www.avanza.se/aktier/om-aktien.html/5247/investor-b"
' Statusbar
Application.StatusBar = "Loading, Please wait..."
' Wait while IE loading...
'Do While IE.Busy
' Application.Wait DateAdd("s", 1, Now)
'Loop
'this should go from ready-busy-ready
IEWait IE
Application.StatusBar = "Searching for value. Please wait..."
' Dim Document As HTMLDocument
' Set Document = IE.Document
Dim dd As Variant
dd = IE.Document.getElementsByClassName("lastPrice SText bold")(0).innerText
MsgBox dd
' Show IE
IE.Visible = True
' Clean up
Set IE = Nothing
Set objElement = Nothing
Set objCollection = Nothing
Application.StatusBar = ""
End Sub
And in module1
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Function IEWait(p_ieExp As InternetExplorer)
'this should go from ready-busy-ready
Dim initialReadyState As Integer
initialReadyState = p_ieExp.ReadyState
'wait 250 ms until it's done
Do While p_ieExp.Busy Or p_ieExp.ReadyState <> READYSTATE_COMPLETE
Sleep 250
Loop
End Function
As said earlier, I do not know if I got the structure right with this latest add-in, not to expired in this kind of coding I'm afraid.
Best Regards
Stop editing 2014-05-12 17:08

You are close but have a couple small errors.
Here is how I would set it up (Tested):
Private Sub CommandButton1_Click()
Dim IE As Object
' Create InternetExplorer Object
Set IE = CreateObject("InternetExplorer.Application")
' You can uncoment Next line To see form results
IE.Visible = False
' URL to get data from
IE.Navigate "https://www.avanza.se/aktier/om-aktien.html/5247/investor-b"
' Statusbar
Application.StatusBar = "Loading, Please wait..."
' Wait while IE loading...
Do While IE.Busy
Application.Wait DateAdd("s", 1, Now)
Loop
Application.StatusBar = "Searching for value. Please wait..."
Dim dd As String
dd = IE.Document.getElementsByClassName("lastPrice SText bold")(0).innerText
MsgBox dd
' Show IE
IE.Visible = True
' Clean up
Set IE = Nothing
Application.StatusBar = ""
End Sub
Results:
Tested in Excel 2010 with the following references:
Edit - Option B
To get rid of a possible "Run-Time Error '91'" try changing a few lines like this:
Dim dd As Variant
Set dd = IE.Document.getElementsByClassName("lastPrice SText bold")
MsgBox dd(0).textContent
Edit - Option C
Yet another way to get elements:
Dim tag
Dim tags As Object
Set tags = IE.Document.getElementsByTagName("*")
For Each tag In tags
If tag.className = "lastPrice SText bold" Then
MsgBox tag.innerText
Exit For
End If
Next tag
(All three methods have been tested on Excel 2010 and IE10)

I just wanted to add the code I'm currently running which works perfectly fine at the moment, if people run into the same problem. This is to get two values into dedicated cells.
Private Sub CommandButton10_Click()
Dim IE As Object
Dim dd As Variant
' Create InternetExplorer Object
Set IE = GetObject("new:{D5E8041D-920F-45e9-B8FB-B1DEB82C6E5E}")
IE.Visible = False
' Send the form data To URL As POST binary request
IE.Navigate "https://www.avanza.se/aktier/om-aktien.html/52476/alk-abell-b"
Application.StatusBar = "Loading, Please wait..."
IEWait IE
Application.StatusBar = "Searching for value. Please wait..."
dd = IE.Document.getElementsByClassName("lastPrice SText bold")(0).innerText
Range("Y2").Value = dd
IE.Navigate "https://www.avanza.se/aktier/om-aktien.html/52380/alm--brand"
Application.StatusBar = "Loading, Please wait..."
IEWait IE
Application.StatusBar = "Searching for value. Please wait..."
dd = IE.Document.getElementsByClassName("lastPrice SText bold")(0).innerText
Range("Y3").Value = dd
' Clean up
Set IE = Nothing
Set objElement = Nothing
Set objCollection = Nothing
Application.StatusBar = ""
End Sub
If one wants more data, it is just to copy the part starting with
IE.Navigate "https://www.pagewhereyourdatayouwanttoextractis.com"
and stops with
Range("Y2").Value = dd
It is ofcourse based if the page you want to extract data from has a similiar structure to the one above.
Hope this can help some people out there.
Best Regards

Related

Excel VBA: Check all check boxes on Web Page

I'm trying to check all the checkboxes available on a webpage via VBA since the name convention doesnt appear to be one in which I can be selective. However I cannot seem to get anything to work. I can login to the website and navigate to the section of the website I want but cannot cross this hurdle. Any help would be greatly appreciate. Below is the source code from the webpage.
<li data-product-family="30yr"
data-product-amortizationTerm="30"
data-product-type="Conventional"
data-product-amortizationType="Fixed"
>
<label>
<input type="checkbox"
value="154232"
class="product-Conventional product-item"
data-authorized-remittance-types="ActualActual "
/>30-Year Fixed Rate - 110k Max Loan Amount</label>
</li>
VBA I attempted to write (edited)... code I'm using presently:
Public Sub TestIE()
Dim IE As Object
Dim aNodeList As Object, i As Long
' Create InternetExplorer Object
Set IE = CreateObject("InternetExplorer.Application")
' You can uncoment Next line To see form results
IE.Visible = False
' Send the form data To URL As POST binary request
IE.Navigate "https://"
' Statusbar
Application.StatusBar = "Page is loading. Please wait..."
' Wait while IE loading...
Do While IE.Busy
Application.Wait DateAdd("s", 1, Now)
Loop
IE.Visible = True
Set aNodeList = IE.document.querySelectorAll("input[type=checkbox]")
If aNodeList Is Nothing Then Exit Sub
For i = 0 To aNodeList.Length
aNodeList.Item(i).Checked = True
Next i
End Sub
You can try to get a nodeList of the checkboxes with:
IE.document.querySelectorAll("input[type=checkbox]")
You can traverse the nodeList along its .Length property.
E.g.
Dim aNodeList As Object, i As Long
Set aNodeList = IE.document.querySelectorAll("input[type=checkbox]")
If aNodeList Is Nothing Then Exit Sub
For i = 0 To aNodeList.Length -1
On Error Resume Next
aNodeList.item(i).Checked = True
On Error GoTo 0
Next i

vba get text from webpage and display as message in excel?

I am using the following code in vba to extract a value from a website.
Let's pretend the value is wrapped inside a html span id. i want to retrieve this value and display it as a message box in excel.
Here's my code:
Sub PullExpiry()
Dim IE As Object
' Create InternetExplorer Object
Set IE = CreateObject("InternetExplorer.Application")
' You can uncoment Next line To see form results
IE.Visible = False
' URL to get data from
IE.Navigate "https://www.brcdirectory.com/InternalSite//Site.aspx?BrcSiteCode=" & Range("J6").Value
' Statusbar
Application.StatusBar = "Loading, Please wait..."
' Wait while IE loading...
Do While IE.Busy
Application.Wait DateAdd("s", 1, Now)
Loop
Application.StatusBar = "Searching for value. Please wait..."
Dim dd As String
dd = IE.Document.getElementsByClassName("ctl00_ContentPlaceHolder1_FormView1_GridView1_ctl02_lb_ExpiryDate")(0).innerText
MsgBox dd
' Show IE
IE.Visible = True
' Clean up
Set IE = Nothing
Application.StatusBar = ""
End Sub
HTML:
<span id="ctl00_ContentPlaceHolder1_FormView1_GridView1_ctl02_lb_ExpiryDate">Expiry Date : 16/02/2018</span>
I get an object doesn't support this property or method error:
IE.Document.getElementsByClassName("ctl00_ContentPlaceHolder1_FormView1_GridView1_ctl02_lb_ExpiryDate")(0).innerText
Please can someone show me where i am going wrong?
EDIT
Other code tried:
Sub PullExpiry()
Dim IE As Object
' Create InternetExplorer Object
Set IE = CreateObject("InternetExplorer.Application")
' You can uncoment Next line To see form results
IE.Visible = False
' URL to get data from
IE.Navigate "https://www.brcdirectory.com/InternalSite//Site.aspx?BrcSiteCode=" & Range("J6").Value
' Statusbar
Application.StatusBar = "Loading, Please wait..."
' Wait while IE loading...
Do While IE.Busy
DoEvents
Loop
Application.StatusBar = "Searching for value. Please wait..."
Dim dd As String
dd = IE.Document.getElementByID("ctl00_ContentPlaceHolder1_FormView1_GridView1_ctl02_lb_ExpiryDate")(0).innerText
MsgBox dd
' Show IE
IE.Visible = True
' Clean up
Set IE = Nothing
Application.StatusBar = ""
End Sub

Excel VB Macro to scrape webpage. Can't code to click html button

I have a short excel macro that is designed to:
1) Open Internet Explorer and navigate to "http://www.puco.ohio.gov/pucogis/address/search.cfm"
2) Fill out a form on that site with data from the excel workbook
3) Click a button to submit the form
4) Scrape some innertext from the website and place it in a cell in the workbook
5) Close Internet Explorer
I can not get step 3 to work. That is, I can not get the click/submit function to work with this website. When the button is clicked the website populates with information specific to the information entered in the form. Everything else in the code is working. I have searched for an answer and tried the submit verses click approach with no luck.
Thanks for you help.
Code below:
Private Sub SiteData()
Dim ie As Object
Dim utility As Variant
Dim HTMLButton
Set ie = CreateObject("InternetExplorer.Application")
ie.Navigate "http://www.puco.ohio.gov/pucogis/address/search.cfm"
ie.Visible = True
While ie.Busy
DoEvents
Wend
ie.Document.all("address").Value = ThisWorkbook.Sheets("Site Info").Range("D14")
While ie.Busy
DoEvents
Wend
Set HTMLButton = ie.Document.getElementsByTagName("input")(1)
HTMLButton.Click
While ie.Busy
DoEvents
Wend
Set utility = ie.Document.getElementById("supName")
ThisWorkbook.Sheets("Site Info").Range("D50") = utility.innerText
ie.Quit
Set ie = Nothing
End Sub
Try this solution, which I found from this answer to a similar question. That answer was not accepted, but I have tested this with your code and seems to be working.
Private Sub SiteData()
Dim ie As Object
Dim utility As Variant
Dim HTMLButton
Set ie = CreateObject("InternetExplorer.Application")
ie.Navigate "http://www.puco.ohio.gov/pucogis/address/search.cfm"
ie.Visible = True
While ie.Busy
DoEvents
Wend
ie.Document.all("address").Value = ThisWorkbook.Sheets("Site Info").Range("D14")
While ie.Busy
DoEvents
Wend
Call ie.Document.parentWindow.execScript("codeAddress()")
While ie.Busy
DoEvents
Wend
Set utility = ie.Document.getElementById("supName")
ThisWorkbook.Sheets("Site Info").Range("D50") = utility.innerText
ie.Quit
Set ie = Nothing
End Sub
If you don't know or can't reasonably anticipate the function call codeAddress(), then you can try something like this to derive it from the button's onclick property:
Dim fn$
fn = HTMLButton.onclick
fn = Mid(fn, InStr(fn, "{"))
fn = Trim(Replace(Replace(Replace(fn, "{", vbNullString), "}", vbNullString), vbLf, vbNullString))
Call ie.Document.parentWindow.execScript(fn)
You can call the JavaScript directly. try this it will work
Instead of:
Set HTMLButton = ie.Document.getElementsByTagName("input")(2)
HTMLButton.Click
use
ie.Document.parentWindow.execScript code:="codeAddress()"
note that IE may prompt you to confirm every run so you may need to
stop showing this message for smooth operation
Private Sub CommandButton1_Click()
Dim ie As Object
Dim utility As Variant
Dim HTMLButton
Set ie = CreateObject("InternetExplorer.Application")
ie.Navigate "http://www.puco.ohio.gov/pucogis/address/search.cfm"
ie.Visible = True
While ie.Busy
DoEvents
Wend
ie.Document.all("address").Value = ThisWorkbook.Sheets("Site Info").Range("D14")
While ie.Busy
DoEvents
Wend
ie.Document.parentWindow.execScript code:="codeAddress()"
'Set HTMLButton = ie.Document.getElementsByTagName("input")(2)
'HTMLButton.Click
While ie.Busy
DoEvents
Wend
Set utility = ie.Document.getElementById("supName")
ThisWorkbook.Sheets("Site Info").Range("D16") = utility.innerText
ie.Quit
Set ie = Nothing
End Sub
thanks also to this article helped me to solve your problem
How to find and call javascript method from vba

VBA Scraping Data From Multiple Websites

I am trying to use VBA to scrape commodity/stock prices from multiple pages on investing.com and insert them into an excel spreadsheet.
The following code is what I have working to do a single price, in this example gold:
Sub Extractdatafromwebsite()
Dim ie As New InternetExplorer
Dim doc As HTMLDocument
ie.Visible = False
ie.navigate "http://uk.investing.com/commodities/gold"
Do
DoEvents
Loop Until ie.READYSTATE = READYSTATE_COMPLETE
Set doc = ie.document
output = doc.GetElementById("last_last").innerText
Range("A1").Value = output
ie.Quit
End Sub
However I need data from multiple sites to get different prices, all at the same time.
I tried elaborating on the code I have that is working, the following example is what I tried to display the price of gold and silver, however it only displayed the gold price in cells A1 & A2:
Sub Extractdatafromwebsite()
Dim ie As New InternetExplorer
Dim doc As HTMLDocument
ie.Visible = False
ie.navigate "http://uk.investing.com/commodities/gold"
Do
DoEvents
Loop Until ie.READYSTATE = READYSTATE_COMPLETE
Set doc = ie.document
output = doc.GetElementById("last_last").innerText
Range("A1").Value = output
ie.Quit
ie.navigate "http://uk.investing.com/commodities/silver"
Set doc = ie.document
output = doc.GetElementById("last_last").innerText
Range("A2").Value = output
ie.Quit
End Sub
Please could somebody help me figure out how to get this to work for multiple pages? I have tried searching however have not come up with anything that suits my needs.
Also is it possible to get something to pop up saying something like "Waiting...." whilst the data is being collected?
Thanks
I've found that using READYSTATE is not reliable in the sense that the document hasn't fully loaded sometimes - or at least the object model hasn't loaded.
So I typically add a sleep command and Doevents before trying to access the new doc object
This should work for you (and as #Dave says, you don't need to use IE.Quit)
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Extractdatafromwebsite()
Dim ie As New InternetExplorer
Dim doc As HTMLDocument
ie.Visible = False
ie.Navigate "http://uk.investing.com/commodities/gold"
Do
Sleep 500
DoEvents
Loop Until ie.ReadyState = 4 ' READYSTATE_COMPLETE
Sleep 500
Set doc = ie.Document
output = doc.GetElementById("last_last").innerText
Range("A1").Value = output
ie.Navigate "http://uk.investing.com/commodities/silver"
Do
Sleep 500
DoEvents
Loop Until ie.ReadyState = 4 ' READYSTATE_COMPLETE
Sleep 500
Set doc = ie.Document
output = doc.GetElementById("last_last").innerText
Range("A2").Value = output
ie.Quit
Set ie = Nothing
End Sub

vba code to fetch data from website

I am a newbie in this website and in VBA programming as well. I am stuck into a problem where I have to fetch the data from this page. I need to have the hyperlink url of Check Rates 10 button. Can anyone help me with this problem.
I have done the following code:
Sub GetData()
Dim IE As New InternetExplorer
IE.navigate "http://www.kieskeurig.nl/zoeken/index.html?q=4960999543345"
IE.Visible = False
Do
DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE
Application.Wait (Now() + TimeValue("00:00:016")) ' For internal page refresh or loading
Dim doc As HTMLDocument 'variable for document or data which need to be extracted out of webpage
Set doc = IE.document
Dim dd As Variant
dd = doc.getElementsByClassName("lgn")(0).outerHtml
'Range("a1").Value = dd
MsgBox dd
End Sub
In which I am getting text of the button but I want to have the value of the class. I think I am very close to the result but somehow cant reach to the goal...can anyone please help me...
Regards,
I think this is what you're looking for:
(Code modified slightly from Kyle's answer here)
Sub Test()
'Must have the Microsoft HTML Object Library reference enabled
Dim oHtml As HTMLDocument
Dim oElement As Object
Dim link As String
Set oHtml = New HTMLDocument
With CreateObject("WINHTTP.WinHTTPRequest.5.1")
.Open "GET", "http://www.kieskeurig.nl/zoeken/index.html?q=4960999543345", False
.Send
oHtml.Body.innerHTML = .responseText
End With
If InStr(1, oHtml.getElementsByClassName("lgn")(0).innerText, "Bekijk 10 prijzen") > 0 Then
link = Mid(oHtml.getElementsByClassName("lgn")(0).href, 7)
Debug.Print "http://www.kieskeurig.nl" & link
End If
End Sub
This code prints the URL to the immediate window. Hope that helps!
This works for me...
Sub GetData()
Set IE = CreateObject("InternetExplorer.Application")
my_url = "http://www.kieskeurig.nl/zoeken/index.html?q=4960999543345"
With IE
.Visible = True
.navigate my_url
.Top = 50
.Left = 530
.Height = 400
.Width = 400
Do Until Not IE.Busy And IE.readyState = 4
DoEvents
Loop
End With
Application.Wait (Now() + TimeValue("00:00:016")) ' For internal page refresh or loading
Set Results = IE.document.getElementsByTagName("a")
For Each itm In Results
If itm.classname = "lgn" Then
dd = itm.getAttribute("href")
Exit For
End If
Next
' if you wnat to click the link
itm.Click
' otherwise
'Range("a1").Value = dd
MsgBox dd
End Sub

Resources