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