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

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

Answer 2

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

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

2 个答案: