Skip to main content

AccessTr.neT


Web'ten Altin Fiyatlarını Çekme

Web'ten Altin Fiyatlarını Çekme

#31
https://www.haremaltin.com/canli-piyasal...-fiyatlari
Yukarıdaki linke göre yapmıştım.

[Resim: do.php?img=10624]

Option Compare Database

Private Sub Getir_Click()

    Dim Getir As New Selenium.WebDriver
    Dim satir, sutun As Integer
    Dim rc As DAO.Recordset
    Dim arr()
   
    Set rc = CurrentDb.OpenRecordset("Tbl_Altin")

        Getir.AddArgument "--headless"
        Getir.Start "chrome"
        Getir.Get "https://www.haremaltin.com/canli-piyasalar/altin-fiyatlari"
        satir = 2
        For Each td In Getir.FindElementByTag("tbody").FindElementsByTag("tr")
            sutun = 1
            For Each t In td.FindElementsByTag("td")
                ReDim Preserve arr(1 To 3, 1 To satir - 1)
                If sutun = 4 Then Exit For 'Yüzde icin
                On Error GoTo var
                If t.Text = "USD/KG" Or t.Text = "EUR/KG" Then GoTo var
                If sutun > 1 Then
                    ReDim Preserve arr(1 To 3, 1 To satir - 1)
                      arr(sutun, satir - 1) = t.Text + 0
                Else
                      arr(sutun, satir - 1) = t.Text
                End If
                sutun = sutun + 1
            Next t
            satir = satir + 1
var:
        On Error GoTo 0
        Next td

  On Error GoTo hata_2
    CurrentDb.Execute ("delete from Tbl_Altin")
    For x = 1 To UBound(arr, 2)
        rc.AddNew
            rc(0) = arr(1, x)
            rc(1) = arr(2, x)
            rc(2) = arr(3, x)

        rc.Update
    Next x
GoTo var2

hata_2:
    MsgBox "Veri bulunamadi yada baska hata var...", vbCritical, "Hata"
var2:
    Set rc = Nothing
    Me.Alt0.Requery
    Erase arr
    MsgBox "Islem Tamam"
End Sub

Eğer selenium kurulumu vs... yapamazsanız bağlanıp ayarlayayım karışık biraz.

Eğer selenium kurulumu vs... yapamazsanız bağlanıp ayarlayayım karışık biraz.

Kod:
For Each td In Getir.FindElementByTag("tbody").FindElementsByTag("tr")
yerine alttaki gibi olursa galiba biraz daha hızlı olabilir.
Kod:
For Each td In Getir.FindElementByXPath("//*[@id='view']/section[2]/div/div/div/div[1]/div[2]/div[2]/table/tbody").FindElementsByTag("tr")
.rar altın fiyatları selenium.rar (Dosya Boyutu: 27,43 KB | İndirme Sayısı: 5)
Cevapla
#32
çok iyi olur mesaj attım telimi.
Cevapla
#33
Artık telefon alıp vermiyorum üstad sizinle alakalı durum değil.
En son eklediğiniz Link içinde kod ekledim.
Option Compare Database

Private Sub Getir_Click()

    Dim Getir As New Selenium.WebDriver
    Dim satir, sutun As Integer
    Dim rc As DAO.Recordset
    Dim arr()
   
    Set rc = CurrentDb.OpenRecordset("Tbl_Altin")
      CurrentDb.Execute ("delete from Tbl_Altin")
      Me.Alt0.Requery
        Getir.AddArgument "--headless"
        Getir.Start "chrome"
        Getir.Get "https://www.haremaltin.com/canli-piyasalar/"
        satir = 2
        For Each td In Getir.FindElementByXPath("//*[@id='view']/section[2]/div/div[1]/div/div[2]/div[2]/div[2]/table/tbody").FindElementsByTag("tr")
            sutun = 1
            For Each t In td.FindElementsByTag("td")
                ReDim Preserve arr(1 To 3, 1 To satir - 1)
                If sutun = 4 Then Exit For 'Yüzde icin
                On Error GoTo var
                If t.Text = "USD/KG" Or t.Text = "EUR/KG" Then GoTo var
                If sutun > 1 Then
                    ReDim Preserve arr(1 To 3, 1 To satir - 1)
                      arr(sutun, satir - 1) = t.Text + 0
                Else
                      arr(sutun, satir - 1) = t.Text
                End If
                sutun = sutun + 1
            Next t
            satir = satir + 1
var:
        On Error GoTo 0
        Next td

  On Error GoTo hata_2

    For x = 1 To UBound(arr, 2)
        rc.AddNew
            rc(0) = arr(1, x)
            rc(1) = arr(2, x)
            rc(2) = arr(3, x)

        rc.Update
    Next x
GoTo var2

hata_2:
    MsgBox "Veri bulunamadi yada baska hata var...", vbCritical, "Hata"
var2:
    Set rc = Nothing
    Me.Alt0.Requery
    Erase arr
    MsgBox "Islem Tamam"
End Sub
.rar altın fiyatları selenium 2.rar (Dosya Boyutu: 24,71 KB | İndirme Sayısı: 12)
Cevapla
#34
Feraz bey emeğiniz için çok teşekkür ederim. Ama bilgiler çok geç geliyor. Daha pratik bir yöntem yok sanırım Img-cray
Cevapla
#35
Sonuçta veri geldi bende 10 saniye felan sürüyor Img-grin
Biraz beklersek xmlhttp ilede çözüm gelme ihtimali var.
İnternetten veri çekmeyi anlamadığım için bilemiyorum.
Cevapla
#36
Valla dört gözle bekliyor olacağım Img-grin
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da