AccessTr.neT

Tam Versiyon: Kur Almak
Şu anda arşiv modunu görüntülemektesiniz. Tam versiyonu görüntülemek için buraya tıklayınız.
Sayfalar: 1 2
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=[Resim: do.php?img=10593]][/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")
Sayfalar: 1 2