Çözüldü Ziraat katılım bankasından altın alış ve satış verilerini excele çekme

[okan32]

Aşağıdaki kod ile ziraat katılım bankasından altın alış ve satış verilerini excele çekiyordum ama dünden bu tarafa hata veriyor. yardımlarınız için şimdiden çok teşekkürler.

Sub AltinVeriAl()
'This will load a webpage in IE
    Dim i As Long
    Dim URL As String
    Dim IE As Object
    Dim objElement As Object
    Dim objCollection As Object
    'Create InternetExplorer Object
    Worksheets("Sayfa1").Unprotect "2713233"
Range("H2") = Format(Now, "dd.mm.yyyy hh:mm")
    Set IE = CreateObject("InternetExplorer.Application")
    'Set IE.Visible = True to make IE visible, or False for IE to run in the background
    IE.Visible = False
    'Define URL
    URL = "https://www.ziraatkatilim.com.tr/"
    'Navigate to URL
    IE.Navigate URL
    ' Statusbar let's user know website is loading
    Application.StatusBar = URL & " is loading. Please wait..."
    ' Wait while IE loading...
    'IE ReadyState = 4 signifies the webpage has loaded (the first loop is set to avoid inadvertently skipping over the second loop)
    Do While IE.ReadyState = 4: DoEvents: Loop   'Do While
    Do Until IE.ReadyState = 4: DoEvents: Loop   'Do Until
    'Webpage Loaded
    Application.StatusBar = URL & " Loaded"
    Application.Wait (Now + TimeValue("0:00:05"))
   ActiveSheet.Range("r1") = IE.document.getelementbyid("piyasalar").innertext
    'Unload IE
    IE.Quit
    Set IE = Nothing
    Set objElement = Nothing
    Set objCollection = Nothing
    'MsgBox "Veriler çekildi."
    Range("G2").Value = Range("J2").Value
    Range("G3").Value = Range("J3").Value
    Range("G4").Value = Range("J4").Value
    Range("G5").Value = Range("J5").Value
    UserForm1.Show 'ana kod bloğuna geçerken bu satır aktif edilmeli
    Worksheets("Sayfa1").Protect "2713233"
    
End Sub

 

[Ali ÖZ]

Merhaba,
Explorer tarayıcısında sertifika sorunu var gibi. Döviz kurları görüntülenmiyor. Sizde de aynı durum olabilir mi ?

 

[okan32]

Merhaba,
Explorer tarayıcısında sertifika sorunu var gibi. Döviz kurları

Merhaba,
Explorer tarayıcısında sertifika sorunu var gibi. Döviz kurları görüntülenmiyor. Sizde de aynı durum olabilir mi ?

Yok hocam şuanda veriler var

 

[Caylak]

Merhaba
Selenium ile;
Aşağıdaki kodları deneyebilirsiniz.

Sub wbaglan()
On Error GoTo Hata
Dim Sb As New Selenium.ChromeDriver
URL = "https://www.ziraatkatilim.com.tr/"
Sb.AddArgument "--headless"
Sb.Get URL
'Sb.Wait 5000
Set usdbuy = Sb.FindElementByClass("piyasalar-finance-portal ").FindElementsById("usd-buy")(1)
Set usdsell = Sb.FindElementByClass("piyasalar-finance-portal ").FindElementsById("usd-sell")(1)
Set eurbuy = Sb.FindElementByClass("piyasalar-finance-portal ").FindElementsById("eur-buy")(1)
Set eursell = Sb.FindElementByClass("piyasalar-finance-portal ").FindElementsById("eur-sell")(1)
Set xaubuy = Sb.FindElementByClass("piyasalar-finance-portal ").FindElementsById("xau-buy")(1)
Set xausell = Sb.FindElementByClass("piyasalar-finance-portal ").FindElementsById("xau-sell")(1)
Set xagbuy = Sb.FindElementByClass("piyasalar-finance-portal ").FindElementsById("xag-buy")(1)
Set xagsell = Sb.FindElementByClass("piyasalar-finance-portal ").FindElementsById("xag-sell")(1)
Range("B2:B5") = Date & " " & Time
Range("C2") = CDbl(Replace(usdbuy.Text, ",", "."))
Range("D2") = CDbl(Replace(usdsell.Text, ",", "."))
Range("C3") = CDbl(Replace(eurbuy.Text, ",", "."))
Range("D3") = CDbl(Replace(eursell.Text, ",", "."))
Range("C4") = CDbl(Replace(Replace(xaubuy.Text, ".", ""), ",", "."))
Range("D4") = CDbl(Replace(Replace(xausell.Text, ".", ""), ",", "."))
Range("C5") = CDbl(Replace(Replace(xagbuy.Text, ".", ""), ",", "."))
Range("D5") = CDbl(Replace(Replace(xagsell.Text, ".", ""), ",", "."))
Sb.Quit
Exit Sub
Hata:
MsgBox "Birşeyler ters gitti"
End Sub

Selenium eklentisini indirmek için
Link Selenium

Chrome Driver için
Link Chrome Driver

 

[okan32]

Merhaba
Selenium ile;
Aşağıdaki kodları deneyebilirsiniz.

Sub wbaglan()
On Error GoTo Hata
Dim Sb As New Selenium.ChromeDriver
URL = "https://www.ziraatkatilim.com.tr/"
Sb.AddArgument "--headless"
Sb.Get URL
'Sb.Wait 5000
Set usdbuy = Sb.FindElementByClass("piyasalar-finance-portal ").FindElementsById("usd-buy")(1)
Set usdsell = Sb.FindElementByClass("piyasalar-finance-portal ").FindElementsById("usd-sell")(1)
Set eurbuy = Sb.FindElementByClass("piyasalar-finance-portal ").FindElementsById("eur-buy")(1)
Set eursell = Sb.FindElementByClass("piyasalar-finance-portal ").FindElementsById("eur-sell")(1)
Set xaubuy = Sb.FindElementByClass("piyasalar-finance-portal ").FindElementsById("xau-buy")(1)
Set xausell = Sb.FindElementByClass("piyasalar-finance-portal ").FindElementsById("xau-sell")(1)
Set xagbuy = Sb.FindElementByClass("piyasalar-finance-portal ").FindElementsById("xag-buy")(1)
Set xagsell = Sb.FindElementByClass("piyasalar-finance-portal ").FindElementsById("xag-sell")(1)
Range("B2:B5") = Date & " " & Time
Range("C2") = CDbl(Replace(usdbuy.Text, ",", "."))
Range("D2") = CDbl(Replace(usdsell.Text, ",", "."))
Range("C3") = CDbl(Replace(eurbuy.Text, ",", "."))
Range("D3") = CDbl(Replace(eursell.Text, ",", "."))
Range("C4") = CDbl(Replace(Replace(xaubuy.Text, ".", ""), ",", "."))
Range("D4") = CDbl(Replace(Replace(xausell.Text, ".", ""), ",", "."))
Range("C5") = CDbl(Replace(Replace(xagbuy.Text, ".", ""), ",", "."))
Range("D5") = CDbl(Replace(Replace(xagsell.Text, ".", ""), ",", "."))
Sb.Quit
Exit Sub
Hata:
MsgBox "Birşeyler ters gitti"
End Sub

Selenium eklentisini indirmek için
Link Selenium

Chrome Driver için
Link Chrome Driver

Teşekürler Hocam