Soru Ziraat katılım bankasından altın alış ve satış verilerini excele çekme

okan32 · 9 Ağustos 2023

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.

Kod:

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

Haluk · 9 Ağustos 2023

Ekli dosyayı kullanabilirsiniz...

.

okan32 · 9 Ağustos 2023

Haluk' Alıntı:
Ekli dosyayı kullanabilirsiniz...

.

Teşekkürler Haluk hocam

okan32 · 10 Ağustos 2023

Haluk' Alıntı:
Ekli dosyayı kullanabilirsiniz...

.

Teşekkürler Haluk hocam
Kendi dosyama uyarlayamadim.
Benim gönderdiğim kodda bir düzenleme yapabilir miyiz

Haluk · 10 Ağustos 2023

Eğer sizin istediğiniz sadece altın alış ve satış fiyatlarıysa, o zaman aşağıdaki kodu deneyin.

Ben sonuçları MsgBox ile gösterdim, siz istediğiniz hücreye yazdırabilirsiniz....

C#:

Sub GetAltin()
    ' Haluk - 14/05/2020
    '
    Dim objHTTP As Object, strURL As String, HTMLcode As String
    Dim regExp As Object, valDoviz As Variant
    
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    
    strURL = "https://www.ziraatkatilim.com.tr/ajax/piyasalar.php"
    
    objHTTP.Open "GET", strURL, False
    objHTTP.setRequestHeader "If-None-Match", "\zoru-basaririz-imkansiz-biraz-zaman-alir\"
    objHTTP.send
    
    If objHTTP.Status = 200 Then
        HTMLcode = objHTTP.responseText
        
        Set regExp = CreateObject("VBScript.RegExp")
        regExp.ignorecase = True
        regExp.Global = True
        regExp.Pattern = """code"":""XAU"",""rate"":(.+?),""diff"":(.+?),""buy"":""(.+?)"",""sell"":""(.+?)"""
        
        Set RetVal = regExp.Execute(HTMLcode)
        
        altinALIS = RetVal(0).SubMatches(2) + 0
        altinSATIS = RetVal(0).SubMatches(3) + 0
                
        MsgBox altinALIS
        MsgBox altinSATIS
   
    ElseIf objHTTP.Status = 429 Then
        MsgBox "Sunucuya çok fazla istek yollandý, bir süre dinlenin....!"
    ElseIf objHTTP.Status = 503 Then
        MsgBox "Sunucuda bakým var, bir süre sonra tekrar deneyin....!"
    Else
        MsgBox "Sunucudan alýnan hata mesajý :" & vbCrLf & vbCrLf & _
               "Kod :" & objHTTP.Status & vbCrLf & vbCrLf & _
               objHTTP.Statustext
    End If
    
    Set regExp = Nothing
    Set objHTTP = Nothing
End Sub

.

okan32 · 10 Ağustos 2023

Haluk' Alıntı:

Eğer sizin istediğiniz sadece altın alış ve satış fiyatlarıysa, o zaman aşağıdaki kodu deneyin.

Ben sonuçları MsgBox ile gösterdim, siz istediğiniz hücreye yazdırabilirsiniz....

C#:

Sub GetData2()
    ' Haluk - 14/05/2020
    '
    Dim objHTTP As Object, strURL As String, HTMLcode As String
    Dim regExp As Object, valDoviz As Variant
  
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
  
    strURL = "https://www.ziraatkatilim.com.tr/ajax/piyasalar.php"
  
    objHTTP.Open "GET", strURL, False
    objHTTP.setRequestHeader "If-None-Match", "\zoru-basaririz-imkansiz-biraz-zaman-alir\"
    objHTTP.send
  
    If objHTTP.Status = 200 Then
        HTMLcode = objHTTP.responseText
      
        Set regExp = CreateObject("VBScript.RegExp")
      
        regExp.ignorecase = True
        regExp.Global = True
        regExp.Pattern = """code"":""XAU"",""rate"":(.+?),""diff"":false,""buy"":""(.+?)"",""sell"":""(.+?)"""
      
        Set RetVal = regExp.Execute(HTMLcode)
      
        altinALIS = RetVal(0).SubMatches(1) + 0
        altinSATIS = RetVal(0).SubMatches(2) + 0
           
        MsgBox altinALIS
        MsgBox altinSATIS
 
    ElseIf objHTTP.Status = 429 Then
        MsgBox "Sunucuya çok fazla istek yollandý, bir süre dinlenin....!"
    ElseIf objHTTP.Status = 503 Then
        MsgBox "Sunucuda bakým var, bir süre sonra tekrar deneyin....!"
    Else
        MsgBox "Sunucudan alýnan hata mesajý :" & vbCrLf & vbCrLf & _
               "Kod :" & objHTTP.Status & vbCrLf & vbCrLf & _
               objHTTP.Statustext
    End If
  
    Set regExp = Nothing
    Set objHTTP = Nothing
End Sub

.

Tamam hocam teşekkürler

okan32 · 11 Ağustos 2023

Haluk' Alıntı:

Eğer sizin istediğiniz sadece altın alış ve satış fiyatlarıysa, o zaman aşağıdaki kodu deneyin.

Ben sonuçları MsgBox ile gösterdim, siz istediğiniz hücreye yazdırabilirsiniz....

C#:

Sub GetData2()
    ' Haluk - 14/05/2020
    '
    Dim objHTTP As Object, strURL As String, HTMLcode As String
    Dim regExp As Object, valDoviz As Variant
  
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
  
    strURL = "https://www.ziraatkatilim.com.tr/ajax/piyasalar.php"
  
    objHTTP.Open "GET", strURL, False
    objHTTP.setRequestHeader "If-None-Match", "\zoru-basaririz-imkansiz-biraz-zaman-alir\"
    objHTTP.send
  
    If objHTTP.Status = 200 Then
        HTMLcode = objHTTP.responseText
      
        Set regExp = CreateObject("VBScript.RegExp")
      
        regExp.ignorecase = True
        regExp.Global = True
        regExp.Pattern = """code"":""XAU"",""rate"":(.+?),""diff"":false,""buy"":""(.+?)"",""sell"":""(.+?)"""
      
        Set RetVal = regExp.Execute(HTMLcode)
      
        altinALIS = RetVal(0).SubMatches(1) + 0
        altinSATIS = RetVal(0).SubMatches(2) + 0
           
        MsgBox altinALIS
        MsgBox altinSATIS
 
    ElseIf objHTTP.Status = 429 Then
        MsgBox "Sunucuya çok fazla istek yollandý, bir süre dinlenin....!"
    ElseIf objHTTP.Status = 503 Then
        MsgBox "Sunucuda bakým var, bir süre sonra tekrar deneyin....!"
    Else
        MsgBox "Sunucudan alýnan hata mesajý :" & vbCrLf & vbCrLf & _
               "Kod :" & objHTTP.Status & vbCrLf & vbCrLf & _
               objHTTP.Statustext
    End If
  
    Set regExp = Nothing
    Set objHTTP = Nothing
End Sub

.

Haluk hocam ekran görüntüsündeki satırda hata verdi

Haluk · 11 Ağustos 2023

5 No'lu mesajdaki kodu revize ettim, onu kullanın...

.

okan32 · 11 Ağustos 2023

Haluk' Alıntı:
5 No'lu mesajdaki kodu revize ettim, onu kullanın...

.

Teşekkürler hocam

Soru Ziraat katılım bankasından altın alış ve satış verilerini excele çekme

okan32

Haluk

Özel Üye

Ekli dosyalar

okan32

okan32

Haluk

Özel Üye

okan32

okan32

Ekli dosyalar

Haluk

Özel Üye

okan32