Skip to main content

AccessTr.neT


Kur Almak

Kur Almak

Çözüldü #1
Merhaba arkadaşlar,
aşağıdaki kod ila kurları alıyoruz yalnız
bulunduğumuz günü alıyor,
tarih seçerek, istediğim tarihin kurlarını nasıl alabilirim.

Dim HTTP As Object, Html As Object
Dim URL As String

URL = "https://yorum.altin.in/tum/dolar"

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

[Dolar] = (HTML.getelementById("sabitDolar").innerText) / 10000
[Euro] = (HTML.getelementById("sabitEuro").innerText) / 10000

End If
Me.Listem.Requery
MsgBox "Veriler Güncellendi"
Set Html = Nothing
Set HTTP = Nothing
Cevapla
#2
Örneğinizi ekleyin inceleyelim ancak kurları almakta olduğunuz sitede detaylı inceleyemedim ama kurların günlük seyri ile ilgili bir veri kaydına da rastlamadım olmayan bir veriyi çekemezsiniz.
Cevapla
#3
Tcmb den alma ile excelde arşivim vardı accesse uyarladım deneyebilirsiniz.
Sizin koddaki site ile bilmiyorum.

[url=[Resim: do.php?img=10593]][/url]
.rar Döviz alis satis.rar (Dosya Boyutu: 35,09 KB | İndirme Sayısı: 4)
Cevapla
#4
Çok teşekkür ederim sayın hocalarım...
Cevapla
#5
Sayın feraz, örneğiniz üzerinde biraz değişiklier yaptım,
yalnız hem alış hem de satışı aynı anda getiremedim,
gönderdiğim örnek üzerinde bakabilirmisiniz lütfen.
.rar KUR alis satis.rar (Dosya Boyutu: 38,66 KB | İndirme Sayısı: 2)
Cevapla
#6
Modüldeki fonksiyonu aşağıdaki ile değiştir

Visual Basic Code
Public Function TCMB_KURU(Para_Birimi As String, Tarih As Variant, Alinan As Variant)
    Dim XL_Dom As Object, Kontrol As Byte
    Dim Sorgulanan_Tarih As Date, Url_Sorgusu As String
    Dim Veri As Variant, Yeni_Tarih As Date, X As Byte
    Dim DovizListesi, Dovizler As Variant
    
    If CDate(Tarih) > Date Then
        TCMB_KURU = "Hatalı Tarih!"
        Exit Function
    End If
    Kontrol = Weekday(CDate(Tarih), vbMonday)
    If Kontrol > 5 Then
        Sorgulanan_Tarih = CDate(Tarih) - (Kontrol - 5)
    Else
        Sorgulanan_Tarih = CDate(Tarih)
    End If
    
    Set XL_Dom = CreateObject("MSXML2.DOMDocument")
    
10  XL_Dom.Async = False
    XL_Dom.ValidateOnParse = False
        
    Url_Sorgusu = "http://www.tcmb.gov.tr/kurlar/" & Year(Sorgulanan_Tarih) & Format(Month(Sorgulanan_Tarih), "00") & "/" & _
                Format(Day(Sorgulanan_Tarih), "00") & Format(Month(Sorgulanan_Tarih), "00") & Year(Sorgulanan_Tarih) & ".xml"
                
                
                   
    
    XL_Dom.Load Url_Sorgusu
     
    Set DovizListesi = XL_Dom.documentElement.selectNodes("Currency")

    If DovizListesi.Length = 0 Then
        If Yeni_Tarih = 0 Then
            Yeni_Tarih = CDate(Tarih) - 1
        Else
            Yeni_Tarih = Yeni_Tarih - 1
        End If

        Kontrol = Weekday(Yeni_Tarih, vbMonday)
        
        If Kontrol > 5 Then
            Sorgulanan_Tarih = Yeni_Tarih - (Kontrol - 5)
            GoTo 10
        Else
            Sorgulanan_Tarih = Yeni_Tarih
            GoTo 10
        End If
    Else
    
        For Each Dovizler In DovizListesi
   
        If Dovizler.SelectSingleNode("Isim").Text = Para_Birimi Then
                      
        TCMB_KURU = Replace(Dovizler.SelectSingleNode("" & Alinan & "").Text, ".", ",")



        End If
        Next
    End If
        
    Set DovizListesi = Nothing
    Set XL_Dom = Nothing
End Function


Formda, butonun tıklandığında olayındaki kodları aşağıdaki ile değiştir.

Visual Basic Code
   If Me.metintarih.Value = "" Or IsNull(Me.metintarih.Value) Then
        MsgBox "Tarih sec", vbCritical
        Exit Sub
    End If
    
    metinEuro.Value = TCMB_KURU("EURO", metintarih.Value, "ForexBuying")
    Metin10.Value = TCMB_KURU("EURO", metintarih.Value, "ForexSelling")
    
    metindolar.Value = TCMB_KURU("ABD DOLARI", metintarih.Value, "ForexBuying")
    Metin12.Value = TCMB_KURU("ABD DOLARI", metintarih.Value, "ForexSelling")
"Boş Örnek Eklerim, Yapıp Verirler" demeyin, örneğinizi hazırlayın.
Komplike kod talebiniz var ise İletişim bağlantısından bize ulaşın. 
Cebelleşmezsen Öğrenemezsin. 
Cevapla

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

Yorum yapmak için üye olmanız gerekiyor

ya da