Question

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

Was it helpful?

Solution

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:

enter image description here


Tested in Excel 2010 with the following references:

enter image description here


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)

OTHER TIPS

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

Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top