Çözüldü Altin fiyatları

[k0081]

Merhaba arkadaşlar;

aşağıdaki kod ile webden verileri almaya çalışıyorum. Ancak bu verilerin nerede olduğunu nasıl bulabilirim . ?

yardımcı arkadaşa şimdiden teşekkürler.

Private Sub CommandButton1_Click()
Dim gramAltin As String
Dim dolar As String
Dim euro As String

    Dim xmlHTTP As Object
    Set xmlHTTP = CreateObject("MSXML2.XMLHTTP")


    Dim url As String
    url = "https://canlidoviz.com/altin-fiyatlari"


    xmlHTTP.Open "GET", url, False
    xmlHTTP.setRequestHeader "Content-Type", "text/xml"
    xmlHTTP.send


    If xmlHTTP.readyState = 4 And xmlHTTP.Status = 200 Then
        Dim htmlDoc As Object
        Set htmlDoc = CreateObject("htmlfile")
        htmlDoc.body.innerHTML = xmlHTTP.responseText

 
   
        gramAltin = htmlDoc.getElementById("/html/body/div[3]/div/div[3]/div/div[1]/div[1]/div[1]/div[4]/table/tbody/tr[1]/td[3]/div/span").innerText

 
   
        dolar = htmlDoc.getElementById("dolar-satis").innerText

   
     
        euro = htmlDoc.getElementById("euro-satis").innerText

   
        MsgBox "Gram Altın Satış Fiyatı: " & gramAltin & vbCrLf & _
               "Dolar Satış Fiyatı: " & dolar & vbCrLf & _
               "Euro Satış Fiyatı: " & euro
    Else
        MsgBox "İstek başarısız oldu!"
    End If
End Sub

 

[veyselemre]

Private Sub CommandButton1_Click()
    Dim gramAltin As String
    Dim dolar As String
    Dim euro As String
    Dim url As String
    Dim xmlHTTP As Object, rws As Object
    Set xmlHTTP = CreateObject("MSXML2.XMLHTTP")
    
    url = "https://canlidoviz.com/altin-fiyatlari"
    xmlHTTP.Open "GET", url, False
    xmlHTTP.setRequestHeader "Content-Type", "text/xml"
    xmlHTTP.send

    If xmlHTTP.readyState = 4 And xmlHTTP.Status = 200 Then
        Dim htmlDoc As Object
        Set htmlDoc = CreateObject("htmlfile")
        htmlDoc.body.innerhtml = xmlHTTP.responseText
        Set rws = htmlDoc.getelementsByTagName("table")(1).Rows

        gramAltin = Split(rws(3).Cells(1).innertext, " ")(0)
        dolar = Split(rws(1).Cells(1).innertext, " ")(0)
        euro = Split(rws(2).Cells(1).innertext, " ")(0)

        MsgBox "Gram Altın Satış Fiyatı: " & gramAltin & vbCrLf & _
               "Dolar Satış Fiyatı: " & dolar & vbCrLf & _
               "Euro Satış Fiyatı: " & euro
    Else
        MsgBox "İstek başarısız oldu!"
    End If
End Sub

 

[k0081]

@veyselemre

Üstad çok teşekkürler. Tamamdır. Elinize sağlık

 

[k0081]

@veyselemre

Üstad çok teşekkürler. Tamamdır. Elinize sağlık

mesaj kutusuna Çeyrek altını da ekleyebilirmiyiz?

 

[Haluk]

        ceyrek = Split(htmlDoc.getelementsByTagName("table")(0).Rows(3).Cells(2).innertext, " ")(0)

.

 

[k0081]

Çok Teşekkür ederim hocam. Tamamdır. Elinize sağlık

 

[mustafa1205]

Hocam bunları mesaj kutusu ile birlikte aynı anda A1 hücresinden itibaren alt alta yazdırmak istersek kodda nasıl bir ekleme yapmalıyız ?