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