+- AccessTr.neT (https://accesstr.net)
+-- Forum: Microsoft Access (https://accesstr.net/forum-microsoft-access.html)
+--- Forum: Access Cevaplanmış Soruları (https://accesstr.net/forum-access-cevaplanmis-sorulari.html)
+--- Konu Başlığı: Web'ten Altin Fiyatlarını Çekme (/konu-web-ten-altin-fiyatlarini-cekme.html)
RE: Web'ten Altin Fiyatlarını Çekme - feraz - 19/12/2020
https://www.haremaltin.com/canli-piyasalar/altin-fiyatlari
Yukarıdaki linke göre yapmıştım.
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")Kod:
For Each td In Getir.FindElementByXPath("//*[@id='view']/section[2]/div/div/div/div[1]/div[2]/div[2]/table/tbody").FindElementsByTag("tr")RE: Web'ten Altin Fiyatlarını Çekme - sertac76 - 19/12/2020
çok iyi olur mesaj attım telimi.
RE: Web'ten Altin Fiyatlarını Çekme - feraz - 19/12/2020
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 SubRE: Web'ten Altin Fiyatlarını Çekme - sertac76 - 19/12/2020
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
RE: Web'ten Altin Fiyatlarını Çekme - feraz - 19/12/2020
Sonuçta veri geldi bende 10 saniye felan sürüyor
Biraz beklersek xmlhttp ilede çözüm gelme ihtimali var.
İnternetten veri çekmeyi anlamadığım için bilemiyorum.
RE: Web'ten Altin Fiyatlarını Çekme - sertac76 - 19/12/2020
Valla dört gözle bekliyor olacağım