Döviz ve altın kurları indirme

[NADİR YILDIZ]

Arkadaşlar merhaba

Kuveyt Türk Katılım Bankası

Kuveyt Türk Katılım Bankacılığı alanlarında yatırım faaliyeti gösteren, hizmet prensiplerine bağlı, sosyal sorumluluk sahibi bir bankadır.

www.kuveytturk.com.tr

sayfasındaki alandan USD - EUR - ALTIN alış ve satışlarını excel sayfaya nasıl aktarım yapabilirim

 

[NADİR YILDIZ]

Arkadaşlar merhaba

bu konuda yardım edebilirmisiniz

 

[Haluk]

Sub Test()
    ' Haluk - 08/03/2024
    '
    Dim objHTTP As Object, strURL As String, HTMLcode As String
    
    Range("D3:E3, H3:I3, L3:M3") = ""
    
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    
    strURL = "https://www.kuveytturk.com.tr/ck0d84?8C5CC4B13366803C5CD94EA5A2119E69"
    
    objHTTP.Open "GET", strURL, False
    objHTTP.send
    
    HTMLcode = objHTTP.responseText
    
    Set regExp = CreateObject("VBScript.RegExp")
    
    regExp.ignorecase = True
    regExp.Global = True
          
    regExp.Pattern = """BuyRate"":""(.+?)"",""SellRate"":""(.+?)"""
        
    If regExp.Test(HTMLcode) Then
        Set objMatches = regExp.Execute(HTMLcode)
                    
        [D3] = Replace(objMatches.Item(1).submatches(0), ",", ".")
        [E3] = Replace(objMatches.Item(1).submatches(1), ",", ".")
        [H3] = Replace(objMatches.Item(2).submatches(0), ",", ".")
        [I3] = Replace(objMatches.Item(2).submatches(1), ",", ".")
        [L3] = Replace(objMatches.Item(3).submatches(0), ".", "")
        [M3] = Replace(objMatches.Item(3).submatches(1), ".", "")
    End If
    
    Range("D3:E3, H3:I3, L3:M3").NumberFormat = "0.00"
    
    Set objMatches = Nothing
    Set regExp = Nothing
    Set objHTTP = Nothing
End Sub

.

 

[NADİR YILDIZ]

Haluk üstat merhaba
teşekkürler

ancak altın tutarını alırken mavi alandaki tutar farklı geliyor

birde butona bastığımdaki tutarla kuveyttürk sitesindeki tutar aynı değil anlık gecikme veri akışından kaynaklı bir durummudur

 

[Haluk]

Ben biraz değişik bir yöntem denemiştim ama sıkıntılı oldu galiba..... Daha sonra müsait bir zamanda başka bir yöntem denerim, ya da bu arada bir başkası size alternatif önerebilir...

.

 

[NADİR YILDIZ]

Tamam üstat teşekkürler

 

[Haluk]

Boş bir sayfada aşağıdaki kodu deneyin...... şu anda doğru verileri getiriyor ama hafta sonu tatilindeyiz. Pazartesi sabahleyin doğru çalışır mı, bilemiyorum.

Sub GetData()
    ' Haluk-09/03/2024
    '
    Dim HTTP As Object, HTML As Object
    Dim URL As String
    Dim Tables As Object, myTable As Object
    
    Range("A1:C" & Rows.Count) = Empty
    
    URL = "https://www.kuveytturk.com.tr/"
    
    Set HTTP = CreateObject("MSXML2.XMLHTTP")
    Set HTML = CreateObject("HTMLFILE")
    
    HTTP.Open "GET", URL, False
    HTTP.send
    
    If HTTP.Status = 200 Then
        HTML.body.innerHTML = HTTP.responseText
        Set Tables = HTML.getelementsByTagName("Table")
        
        Set myTable = Tables(3)
        
        For i = 0 To myTable.Rows.Length - 1
            For j = 0 To myTable.Rows(0).Cells.Length - 1
                If j = 0 Then
                    Cells(i + 1, j + 1) = Split(myTable.Rows(i).Cells(j).innertext, vbLf)(0)
                Else
                    Cells(i + 1, j + 1) = Replace(Split(myTable.Rows(i).Cells(j).innertext, vbLf)(1), ",", ".")
                End If
            Next
        Next
    End If
    
    Set myTable = Nothing
    Set Tables = Nothing
    Set HTML = Nothing
    Set HTTP = Nothing
End Sub

.

 

[Haluk]

Herhangi bir sorun gözükmüyor...

.

 

[NADİR YILDIZ]

saniyelik kur değişimlerinde farklar olabiliyor

düzeltme imkanı olabilirse ne ala
yoksa da çok önemli değil üstat

Aklınıza sağlık

 

[Haluk]

O konuda düzeltilecek bir durum yok, sizin sunucuya isteği gönderdiğiniz andaki veriler alınıyor.

İstek sunucuya gönderildikten sonra, sunucudaki veri güncelleniyorsa, ona Bill Gates bile birşey yapamaz....


Siz sunucuya isteği manuel olarak gönderdiğiniz için, aradaki zaman farkından dolayı böyle bir durum oluyor. Olmazsa @beab05 'e danışın....Kendisinin bazı "Real Time" çalışmaları var, belki sizin için birşeyler yapabilir.

.

 

[NADİR YILDIZ]

tamam üstat anlaşılmıştır

bill gates gitmeye gerek yok zaten

teşekkürler & iyi çalışmalar

 

[beab05]

O konuda düzeltilecek bir durum yok, sizin sunucuya isteği gönderdiğiniz andaki veriler alınıyor.

İstek sunucuya gönderildikten sonra, sunucudaki veri güncelleniyorsa, ona Bill Gates bile birşey yapamaz....


Siz sunucuya isteği manuel olarak gönderdiğiniz için, aradaki zaman farkından dolayı böyle bir durum oluyor. Olmazsa @beab05 'e danışın....Kendisinin bazı "Real Time" çalışmaları var, belki sizin için birşeyler yapabilir.

.

Merhaba;

@Haluk üstadım; anlık veri için Excel'in RTD(GZV) fonksiyonunu kullanmak gerekiyor bunun için de com nesnesinden bir sunucu yapmak gerekir. Bahsi geçen sitenin de WS(WebSocket) servisini göremedim yani sunucu tarafında da timer ile yapmak gerekecektir. Soruyu soran arkadaş için de sizin çözümünüz çok iyi bence