AccessTr.neT

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

Ö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.

Tcmb den alma ile excelde arşivim vardı accesse uyarladım deneyebilirsiniz.
Sizin koddaki site ile bilmiyorum.

[url=][/url]

Çok teşekkür ederim sayın hocalarım...

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.

Modüldeki fonksiyonu aşağıdaki ile değiştir

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.

   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")