Çözüldü Siteden veri çekme(haremaltin.com)

Refaz · 15 Nis 2022

Merhaba.

Canlı Altın Fiyatları & Canlı Döviz Kurları | Harem Altın

Öğrenmek için yukardaki sitede antreman yaptım yine sonuç başarısız.
Daha önce bir üstad Api ile çok hızlı veri çekme dosya vermişti onuda yekledim buraya.

CreateObject("MSXML2.XMLHTTP") yöntemi ile Canlı Altın Fiyatları & Canlı Döviz Kurları | Harem Altın bu siteki tablodan nasıl veri alınıyor.
Birde sadece EURO/TL deki sadece Alışı tek hücreye döngüsüz nasıl alınacak?

Saygılar.

Excelismail · 15 Nis 2022

Hocam anlasam da sizin için yapardım.

Refaz · 15 Nis 2022

mehmetveliyy' Alıntı:
Hocam anlasam da sizin için yapardım.

Üstadlar halleder

Biraz daha uğraşacağım artık.Alında kolayda bir yerde takıldım ilerleyemedim.

Refaz · 18 Nis 2022

Bu arada yazdığım gibi Api kodlarıyla ışık hızında veriler geliyor lazım olan varsa o siteden.
Bir kişi için yazılmıştı ve kuyumcuydu galiba ve kuyumcular heralde o siteden veri alıyor diyordu unuttum geçmiş zaman.

Refaz · 19 Nis 2022

Bu siteden veri alınmıyormu üstadlar ilk mesajda yazdığım yöntemle?

halily · 19 Nis 2022

hocam bu konularda pek bilgim yok o nedenle denemelerim hüsranla sonuçlandı
sabit verileri bir yere kadar alıyor ama zaman yada fiyat gibi değişken verilerin yerine hep "-" tire getiriyor

Refaz · 19 Nis 2022

halily' Alıntı:
hocam bu konularda pek bilgim yok o nedenle denemelerim hüsranla sonuçlandı
sabit verileri bir yere kadar alıyor ama zaman yada fiyat gibi değişken verilerin yerine hep "-" tire getiriyor

Banada hep - getiriyor.Sadece rakamları aldıramadım isimler alınıyor dolambaşlı olsada.Heralde bu sitedeki verileri çekmeyi öğrenen tümünü öğrenir.Adamlar hep aynı tag lar kullanmışlar insanları uğraştırmak için insan id ile yapar bari

Refaz · 19 Nis 2022

Başka bir forumada aynısını sordum ses seda yok

Orda Ozan İlgün hoca var bu işlerin Pir'i.
Ondanda bir haber yok

Demekki bayağı zor ve bu dosyadaki api yada json ile yapılan kodu o yazmıştı.
Aslında o böyle konulara hemen cevaap verirdi ama bakalım artık.
Ama çözülsede çözülmesede bayağı çözdüm mantığı onca video izleyerek

muratboz06 · 19 Nis 2022

Alternatif çözüm.
Referanslardan Microsoft Internet Controls u ekleyiniz.

Kod:

Sub HaremAltin()
    Dim IE As InternetExplorer, ws As Worksheet, hTable As Object, tRow As Object, td As Object, r As Long, c As Long, headers()
    headers = Array("name", "value", "action")
    Set ws = ThisWorkbook.Worksheets(1): Set IE = New InternetExplorer
   
    With IE
        .Visible = False
        .Navigate2 "https://www.haremaltin.com/"

        While .Busy Or .readyState < 4: DoEvents: Wend
     
        End With
        IE.Refresh
         Application.Wait (Now + TimeValue("0:00:03"))
         Set tbl = IE.document.getelementsbyclassname("table")

        Set tr_coll = tbl(0).getelementsbytagname("TR")

        For Each tr In tr_coll
            j = 1
            Set td_col = tr.getelementsbytagname("TD")

            For Each td In td_col
                Cells(row + 1, j).Value = td.innerText
                j = j + 1
            Next
            row = row + 1
        Next
   
     IE.Quit
    MsgBox "Veriler Alındı."
End Sub

Excelismail · 19 Nis 2022

Hocam aslında dizi film gibi her hafta veri çekme ile alakalı bir YouTube videosu bence olur. Nasıl yapıldığıda anlatılırsa çok iyi olur. Bu arada Aşağıdaki Kodlar da Altını çekmek için kullanılabilir..

C#:

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

C++:

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

Refaz · 19 Nis 2022

muratboz06' Alıntı:

Alternatif çözüm.
Referanslardan Microsoft Internet Controls u ekleyiniz.

Kod:

Sub HaremAltin()
    Dim IE As InternetExplorer, ws As Worksheet, hTable As Object, tRow As Object, td As Object, r As Long, c As Long, headers()
    headers = Array("name", "value", "action")
    Set ws = ThisWorkbook.Worksheets(1): Set IE = New InternetExplorer
  
    With IE
        .Visible = False
        .Navigate2 "https://www.haremaltin.com/"

        While .Busy Or .readyState < 4: DoEvents: Wend
    
        End With
        IE.Refresh
         Application.Wait (Now + TimeValue("0:00:03"))
         Set tbl = IE.document.getelementsbyclassname("table")

        Set tr_coll = tbl(0).getelementsbytagname("TR")

        For Each tr In tr_coll
            j = 1
            Set td_col = tr.getelementsbytagname("TD")

            For Each td In td_col
                Cells(row + 1, j).Value = td.innerText
                j = j + 1
            Next
            row = row + 1
        Next
  
     IE.Quit
    MsgBox "Veriler Alındı."
End Sub

Sağolun kod çalıştı süreyi 10 saniye falan yapınca tam alıştı.
Birde Cells(row + 1, j).Value = td.innerText bunun önüne ws. eklemeyi unutmuşsunuz sorun değil.
Acaba CreateObject("MSXML2.XMLHTTP") yöntemi ile neden çalışmıyor onu merak ettim?

Refaz · 19 Nis 2022

muratboz06 hocam izninzle koıdunuzu alttaki gibi düzenledim başlık format vs.. için kullanan olursa diye.
sadece en alta gereksiz veri geliyor onada müdahale etmedim.
Amaç zaten öğrenmekti

Rich (BB code):

Sub HaremAltin()
    Dim IE As InternetExplorer, ws As Worksheet, hTable As Object, tRow As Object, td As Object, r As Long, c As Long, headers()
    headers = Array("name", "value", "action")
    Set ws = ThisWorkbook.Worksheets("Sayfa1"): Set IE = New InternetExplorer
  
  
   ws.Cells.Clear
   Row = 2
    With IE
        .Visible = False
        .Navigate2 "https://www.haremaltin.com/"


        While .Busy Or .readyState < 4: DoEvents: Wend
            DoEvents
        End With
        IE.Refresh
         Application.Wait (Now + TimeValue("0:00:05"))
        
         Set tbl = IE.document.getElementsByClassName("priceHead")(0).getElementsByTagName("th")
         ws.Range("A1").Value = tbl(0).innerText
         ws.Range("B1").Value = tbl(1).innerText
         ws.Range("C1").Value = tbl(2).innerText
         ws.Range("D1").Value = tbl(3).innerText
        
         Set tbl = IE.document.getElementsByClassName("table")
        
            
        Set tr_coll = tbl(0).getElementsByTagName("TR")


        For Each tr In tr_coll
            j = 1
            Set td_col = tr.getElementsByTagName("TD")


            For Each td In td_col


                If j = 2 Or j = 3 Then
                    ws.Cells(Row, j).Value = CDbl(td.innerText)
                ElseIf j = 1 Then
                    ws.Cells(Row, j).Value = Split(td.innerText, vbNewLine)(0)
                ElseIf j = 4 Then
                    ws.Cells(Row, j).Value = Split(td.innerText, vbNewLine)(1)
                End If
                j = j + 1
            Next
            Row = Row + 1
        Next
        ws.Range("B2:C" & ws.Cells(Rows.Count, 1).End(3).Row).NumberFormat = "#,##0.00"
     IE.Quit
    MsgBox "Veriler Alindi."
End Sub

muratboz06 · 19 Nis 2022

Refaz' Alıntı:
Sağolun kod çalıştı süreyi 10 saniye falan yapınca tam alıştı.
Birde Cells(row + 1, j).Value = td.innerText bunun önüne ws. eklemeyi unutmuşsunuz sorun değil.
Acaba CreateObject("MSXML2.XMLHTTP") yöntemi ile neden çalışmıyor onu merak ettim?

Sorguyu gönderdiğinizde json data yüklenmemiş (tablo oluşmamış olduğundan) olduğundan tablo da herhangi bir veri görünmüyor. Konuya hakim üstadlar json hakkında detaylı bilgi verebilirler.

Refaz · 19 Nis 2022

muratboz06' Alıntı:
Sorguyu gönderdiğinizde json data yüklenmemiş (tablo oluşmamış olduğundan) olduğundan tablo da herhangi bir veri görünmüyor. Konuya hakim üstadlar json hakkında detaylı bilgi verebilirler.

Tamam abey sağolun.

Refaz · 19 Nis 2022

Diğer forumdaki Ozan hocamda olmaz demiş ve internet explorer ile örnek kod eklemiş.

C#:

Sub TAbloAL1Dz()
   On Error GoTo son
   Dim syf As Worksheet
 
   Application.ScreenUpdating = False
    Set syf = ThisWorkbook.Worksheets("Sayfa1")
    syf.UsedRange.Cells.ClearContents
  Dim ie As New InternetExplorer
   Dim row As HTMLTableRow
    Dim doc As HTMLDocument
      Dim cell As HTMLTableCell
 
    Dim tablo As HTMLTable
  Dim body As HTMLBody

 
 
    ie.Visible = False
       ie.navigate "https://www.haremaltin.com/"

     Do Until ie.readyState = READYSTATE_COMPLETE
  DoEvents
  Loop
  Application.Wait (Now + TimeValue("0:00:5"))
 

    
   Set body = ie.document.body
   Set doc = ie.document


Set tablo = doc.getElementById("tr__genel__ALTIN").parentElement.parentElement
If tablo.Rows.Length = 0 Then GoTo son
 
 

   Dim satno As Integer
   Dim sutno As Integer
   satno = 2
   sutno = 1
For Each row In tablo.Rows

sutno = 1
For Each cell In row.Cells
   Cells(satno, sutno).Value = cell.innerText
   sutno = sutno + 1
Next cell
satno = satno + 1
Next row
MsgBox satno
Rows(satno - 1).ClearContents
GoTo temizlik
son:
MsgBox "Bir hatayla karşılaşıldı.", vbCritical
GoTo temizlik
temizlik:
  Set syf = Nothing: Set html = Nothing
  ie.Quit
  Set ie = Nothing
  Set tablo = Nothing
  Set row = Nothing
  Set cell = Nothing
 
   Application.ScreenUpdating = True
End Sub

Foruma hoş geldin 👋 Ziyaretçi

Çözüldü Siteden veri çekme(haremaltin.com)

Refaz

Canlı Altın Fiyatları & Canlı Döviz Kurları | Harem Altın

Ekli dosyalar

muratboz06

Excelismail

Refaz

Refaz

Refaz

halily

Refaz

Refaz

muratboz06

Excelismail

Refaz

Refaz

muratboz06

Refaz

Refaz

Foruma hoş geldin 👋 Ziyaretçi

Çözüldü Siteden veri çekme(haremaltin.com)

Canlı Altın Fiyatları & Canlı Döviz Kurları | Harem Altın​

Ekli dosyalar

Canlı Altın Fiyatları & Canlı Döviz Kurları | Harem Altın