Webden id'ye Göre Veri Çekme

[steppe]

Merhaba Arkadaşlar,
İnternetten veya bu siteden bulduğum örnek dosyada id'ye göre veri çekme işini yapamadım.

Tools-Referencesten Microsoft internet controls ve Microsoft HTML Object Library tikledim.

Private Sub CommandButton1_Click()
On Error Resume Next
Set ie = CreateObject("internet explorer.application")
ie.navigate "https://yorum.altin.in/tum/dolar"
Do
DoEvents
Loop Until ie.Busy <> True
Range("B1") = ie.document.getElementById("dfiy").innerText
Range("B2") = ie.document.getElementById("ofiy").innerText
Range("B3") = ie.document.getElementById("efiy").innerText
ie.Quit
Set ie = Nothing

MsgBox "Veriler Güncellendi"
End Sub

Yardımlarınız için şimdiden teşekkür ederim.

 

[Haluk]

Sub Test()
    Dim URL As String
    Dim IE As Object
    
    URL = "https://yorum.altin.in/tum/dolar"
    Set IE = CreateObject("InternetExplorer.Application")
    IE.navigate URL
    
    Do Until IE.ReadyState = 4
    DoEvents
    Loop
    
    Range("B1") = IE.document.getElementById("dfiy").innerText
    Range("B2") = IE.document.getElementById("ofiy").innerText
    Range("B3") = IE.document.getElementById("efiy").innerText
    
    IE.Quit
    MsgBox "Veriler Güncellendi"
    Set IE = Nothing
End Sub

.

 

[Haluk]

Aşağıdaki kod ise, daha hızlı çalışır....

Sub GetData()
    ' Haluk - 13/10/2019
    ' sa4truss@gmail.com
    '
    Dim HTTP As Object, HTML As Object
    Dim URL As String
        
    URL = "https://yorum.altin.in/tum/dolar"
    
    Set HTTP = CreateObject("MSXML2.XMLHTTP")
    Set HTML = CreateObject("HTMLFILE")
    
    HTTP.Open "GET", URL, False
    HTTP.send
    
    If HTTP.Status = 200 Then
        HTML.body.innerHTML = HTTP.responseText
        Range("B1") = Split(HTML.getelementsByTagName("div")(7).innerText, vbLf)(1)
        Range("B2") = Split(HTML.getelementsByTagName("div")(6).innerText, vbLf)(1)
        Range("B3") = Split(HTML.getelementsByTagName("div")(8).innerText, vbLf)(1)
    End If
    
    MsgBox "Veriler Güncellendi"
    Set HTML = Nothing
    Set HTTP = Nothing
End Sub

.

 

[Haluk]

Bu da başka bir alternatif;

Referanslardan "Microsoft HTML Object Library" eklenmesi gerekir.

Sub GetData2()
    ' Haluk - 13/10/2019
    ' sa4truss@gmail.com
    '
    Dim HTTP As Object
    Dim URL As String
      
    URL = "https://yorum.altin.in/tum/dolar"
  
    Set HTTP = CreateObject("MSXML2.XMLHTTP")
    Dim HTML As New HTMLDocument
  
    HTTP.Open "GET", URL, False
    HTTP.send
  
    If HTTP.Status = 200 Then
        HTML.body.innerHTML = HTTP.responseText
        Range("B1") = Split(HTML.getElementsByClassName("dolar")("dolar").innerText, vbLf)(1)
        Range("B2") = Split(HTML.getElementsByClassName("ons")("ons").innerText, vbLf)(1)
        Range("B3") = Split(HTML.getElementsByClassName("dolar eurost")("euro").innerText, vbLf)(1)
    End If
  
    MsgBox "Veriler Güncellendi"
    Set HTML = Nothing
    Set HTTP = Nothing
End Sub

.

 

[Orion1]

Haluk hocam teşekkür ederim.
Aşağıdaki kodda 200 sabitmi olacak devamlı.

If HTTP.Status = 200 Then

 

[Haluk]

Evet...orasi Status=OK anlaminda.

.

 

[Haluk]

Başka bir alternatif;

Sub GetData2()
    ' Haluk - 13/10/2019
    ' sa4truss@gmail.com
    '
    Dim HTTP As Object, HTML As Object
    Dim URL As String
    
    Range("B1:B3") = ""
        
    URL = "https://yorum.altin.in/tum/dolar"
    
    Set HTTP = CreateObject("MSXML2.XMLHTTP")
    Set HTML = CreateObject("HTMLFILE")
    
    HTTP.Open "GET", URL, False
    HTTP.send
    
    If HTTP.Status = 200 Then
        HTML.body.innerHTML = HTTP.responseText
        Range("B1") = HTML.getelementById("sabitDolar").innerText
        Range("B2") = HTML.getelementById("sabitEuro").innerText
        Range("B3") = HTML.getelementById("sabitOns").innerText
    End If
    
    MsgBox "Veriler Güncellendi"
    Set HTML = Nothing
    Set HTTP = Nothing
End Sub

.

 

[steppe]

Haluk Hocam,
Yardımlarınız için çok teşekkür ederim.

 

[Haluk]

Haluk Hocam,
Yardımlarınız için çok teşekkür ederim.

Rica ederim...

Yukarıdaki alternatiflere ilave olarak bir kaç alternatifin daha dahil edildiği, toplam 7 adet olmak üzere hepsinin belirtildiği örnek dosya ektedir.

"XMLHTTP" kullanılan tüm alternatifler "IE" nesnesine göre çok daha hızlı çalışmaktadır. Bununla birlikte, dosyada özellikle, 7. alternatif (XMLHTTP + QuerySelector) ilginç ve hızlı olduğu kadar da güzeldir....

.

 

[Necdet]

Derli toplu bilgiler.
Elinize, emeğinize, bilginize sağlık Haluk bey.

 

[Erdem Akdemir]

Haluk hocam elinize sağlık.

 

[Zeki Gürsoy]

querySelector fonksiyonu CSS element seçim kuralıyla kullanılır... CSS Selector Reference

 

[Erdem Akdemir]

@Haluk hocam ntv.com.tr adresinden döviz bilgilerini almak istiyorum. XMLHTTP nesnesi ile nokta atışı yaparak kur bilgisini nasıl alabiliriz.
Data-price ifadesinin hangi getelement içinde kullanmamız gerekiyor.

 

[Haluk]

Aşağıdaki gibi olabilir...

    '
    '......
    '....
    '..
    If HTTP.Status = 200 Then
        HTML.body.innerHTML = HTTP.responseText
        MsgBox HTML.querySelector(".finance-data").getElementsByTagName("span")(4).innerText
    End If
    '....
    '...
    '..

.

 

[Erdem Akdemir]

Nokta atışı yapılamıyor sanırım. 4 rakamını bulmak için döngü lazım yada kendim yazmam gerekiyor.

Haluk bey teşekkür ederim.

 

[Haluk]

HTML sayfa yapısında "DOLAR" için "id" tanımlanmadığından nokta atışı yapılamıyor.

.

 

[Haluk]

Diğer alternatifler ise;

    If HTTP.Status = 200 Then
        HTML.body.innerHTML = HTTP.responseText
        MsgBox HTML.querySelectorAll("[data-price]")(1).innerText
        MsgBox Split(HTML.querySelectorAll("a[href$=""/ekonomi/doviz""]")(0).innerText, vbLf)(0)
        MsgBox HTML.querySelector("div.finance-data").getElementsByTagName("span")(4).innerText
        MsgBox Split(HTML.querySelector("div.finance-data").Children(0).innerText, vbLf)(2)
        MsgBox HTML.querySelector("div.finance-data").getElementsByTagName("span")(4).getAttribute("data-price")
    End If

.

 

[Orion1]

Haluk hocama ve Zeki hocama teşekkür ederim.

 

[Erdem Akdemir]

Haluk hocam maşallah.

 

[Orion1]

Haluk hocam,
Birde olursa eğer, xml kodlarını kullanarak alabilirmiyiz?