在html类问题中获取股票价格。通过InternetExplorer.application创建股票代码

时间:2014-08-22 09:44:36

标签: vba excel-vba excel

我试图创建自己的股票价格。现在我试图获得索引和信托基金的股票价格,使事情复杂化。我想访问以下网址的代码:https://www.avanza.se/fonder/om-fonden.html/313047/norron-active-r

现在问题是进入180.05(在" NAV-kurs"下)票价,这是在HTML类" SText bold" (右键单击价格并选择视图组件)。

我可以通过getelementbyid通过yahoo finance来做个股但是如何访问HTML类的innertext?我找不到任何与我尝试过的getelementbyclassname相关的属性。

以下代码

Private Sub get_ticker()

Dim ie_app As InternetExplorer
Dim ie_doc As htmldocument
Dim ticker As String

Set ie_app = CreateObject("internetexplorer.application")

ie_app.Visible = True
ie_app.navigate ("https://www.avanza.se/fonder/om-fonden.html/313047/norron-active-r")

Do Until ie_app.readyState = READYSTATE_COMPLETE
    DoEvents
Loop

Set ie_doc = ie_app.document

ticker = ie_doc.getelement <<---- gaah 
Debug.Print ticker



End Sub

2 个答案:

答案 0 :(得分:1)

作弊 - 该页面包含jQuery,它可以更好地用于选择没有ID的元素,例如。告诉它要查找包含div的{​​{1}} XSText NAV SEKdiv.XSText:contains('NAV SEK')并阅读下一个元素的文字:

...
Set ie_doc = ie_app.Document

''Create a new element in the document we can read from:
Dim tempInput As HTMLInputElement
Set tempInput = ie_doc.createElement("input")
tempInput.Type = "hidden"
tempInput.ID = "tempInput"

'' add it to the document
ie_doc.appendChild tempInput

'' use jQuery to lookup the value and assign it to the temp input
ie_doc.parentWindow.execScript("$('#tempInput').val($( ""div.XSText:contains('NAV SEK')"" ).next().text())")

'' read the value
msgbox tempInput.Value

答案 1 :(得分:1)

如果你不愿意使用Javascript,你可以尝试类似的东西。

注意:此代码依赖于早期绑定,并且需要在引用中勾选Microsoft XML(v6.0)和Microsoft HTML Object Library。

Sub getPrice()

    Dim xhr As MSXML2.XMLHTTP60
    Dim doc As MSHTML.HTMLDocument
    Dim XSText As MSHTML.IHTMLElementCollection
    Dim elt As MSHTML.HTMLDivElement
    Dim parentElt As MSHTML.HTMLLIElement
    Dim myPrice As Single

    Set xhr = New MSXML2.XMLHTTP60

    With xhr
        .Open "GET", "https://www.avanza.se/fonder/om-fonden.html/313047/norron-active-r", False
        .send

        If .readyState = 4 And .Status = 200 Then
            Set doc = New MSHTML.HTMLDocument
            doc.body.innerHTML = .responseText
        Else
            MsgBox "xhr error"
            Exit Sub
        End If
    End With

    set xhr = Nothing

    Set XSText = doc.getElementsByClassName("XSText")

    For Each elt In XSText
        If InStr(elt.innerHTML, "NAV SEK") <> 0 Then
            Set parentElt = elt.parentElement
            myPrice = CSng(parentElt.getElementsByClassName("SText bold")(0).innerHTML)
        End If
    Next

    MsgBox myPrice

End Sub
相关问题