我无法从跨度提取数据到excel

时间:2019-02-05 20:04:24

标签: html excel vba web-scraping

我想将我的excel的最后价格提取到excel  ı无法从span到Excel提取数据 我尝试了一些代码,但是没有用 我该如何解决?

Sub Düğme1_Tıkla()
sirketismi = Range("a1")


Dim ie As New InternetExplorer

ie.Visible = True
ie.navigate "https://www.isyatirim.com.tr/tr-tr/analiz/hisse/Sayfalar/sirket-karti.aspx?hisse=" & sirketismi
Do
Loop Until ie.readyState = READYSTATE_COMPLETE


Dim doc As HTMLDocument
Set doc = ie.document

gf = doc.getElementById("hisse_Son")(0).innerText

gf = Range("f12")

End Sub

2 个答案:

答案 0 :(得分:0)

Internet Explorer:

getElementById返回单个元素,因此您无需对其进行索引。

doc.getElementById("hisse_Son").innerText

使用定时循环以确保有时间填充值

Option Explicit
Public Sub GetInfo()
    Dim ie As InternetExplorer, ws As Worksheet, ele As Object
    Dim t As Date, val As String
    Const MAX_WAIT_SEC As Long = 10            '<==Adjust wait time
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set ie = New InternetExplorer

    With ie
        .Visible = True
        .Navigate2 "https://www.isyatirim.com.tr/tr-tr/analiz/hisse/sayfalar/sirket-karti.aspx?hisse=ADANA"

        While .Busy Or .readyState < 4: DoEvents: Wend
        t = Timer
        Do
            On Error Resume Next
            Set ele = .document.querySelector("#hisse_Son") '(".tahminyiltable td + td")
            val = ele.innerText
            On Error GoTo 0
            If Timer - t > MAX_WAIT_SEC Then Exit Do
        Loop While val = vbNullString
        Activesheet.Range("F12") =  val
        .Quit
    End With
End Sub

XMLHTTP:

您还可以模仿页面的XHR POST请求,并使用json解析器从json响应中解析出该值。我使用jsonconverter.bas,然后将.bas下载并添加到项目中,然后转到VBE>工具>引用>为Microsoft Scripting Runtime添加引用。

Option Explicit
Public Sub GetInfo() 
    Const URL As String = "https://www.isyatirim.com.tr/_layouts/15/IsYatirim.Website/StockInfo/CompanyInfoAjax.aspx/GetSermayeArttirimlari"
    Dim  data As String, json As Object
    data = "{""hisseKodu"": ""ADANA"", ""hisseTanimKodu"": """", ""yil"":0, ""zaman"":""HEPSI"", ""endeksKodu"":""09"",""sektorKodu"":""""}"
    With CreateObject("MSXML2.XMLHTTP")
        .Open "POST", URL, False
        .setRequestHeader "Content-Type", "application/json; charset=UTF-8"
        .setRequestHeader "Accept", "application/json, text/javascript, */*; q=0.01"
        .Send data
        Set json = jsonconverter.ParseJson(Replace$(Replace$(Replace$(.responseText, "\", vbNullString), Chr$(34) & "[", "["), "]" & Chr$(34), "]"))
        Activesheet.Range("F12") =  json("d")(1)("PRICE_TL")
    End With
End Sub

答案 1 :(得分:0)

With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", "https://www.isyatirim.com.tr/_layouts/15/Isyatirim.Website/Common/Data.aspx/OneEndeks?endeks=" & Range("A1") & ".E.BIST", False
    .Send
    Range("F12") = Split(Split(.ResponseText, """last"":", 2)(1), ",", 2)(0)
End With