Я не могу извлечь данные из диапазона, чтобы превзойти

Question

Я хочу извлечь мою последнюю цену из 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

Answer 1

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

Answer 2

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:

Вы также можете имитировать запрос POST XHR страницы и использовать анализатор 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