+- AccessTr.neT (https://accesstr.net)
+-- Forum: Microsoft Access (https://accesstr.net/forum-microsoft-access.html)
+--- Forum: Access Cevaplanmış Soruları (https://accesstr.net/forum-access-cevaplanmis-sorulari.html)
+--- Konu Başlığı: Tabloya Döviz Kurlarının Getirilmesi (/konu-tabloya-doviz-kurlarinin-getirilmesi.html)
Tabloya Döviz Kurlarının Getirilmesi - truhi - 24/06/2023
Merhaba,
Ekli veritabanında ilgili alanlara günlük döviz kurlarının getirilmesi nasıl sağlanabilir?
bir form açıldığında güncelleme yapılabilir...
Excel de aşağıdaki kodu kullanıyorum, ve günlük kurları sorunsuz getiriyor, bunu Access' e nasıl uyarlayabiliriz?
teşekkürler, iyi haftasonları..
=TCMB_Kur("14.10.2018";"USD";"Döviz Satış")
Kod:
Function TCMB_Kur(Tarih As Date, DovTip As String, Tipi As String) As Variant
On Error GoTo 20
Dim xDoc As Object
Set xDoc = CreateObject("MSXML2.DOMDocument")
xDoc.async = False
xDoc.validateOnParse = False
If Tarih = Date Then
strURL = "http://www.tcmb.gov.tr/kurlar/today.xml"
Else
If Weekday(Tarih, vbMonday) = 6 Then
Tarih = Tarih - 1
ElseIf Weekday(Tarih, vbMonday) = 7 Then
Tarih = Tarih - 2
End If
myDay = Format(Day(CDate(Tarih + 0)), "00")
myMonth = Format(CDate(Month(Tarih + 0)), "00")
myYear = Year(CDate(Tarih + 0))
strURL = "http://www.tcmb.gov.tr/kurlar/" & myYear & myMonth & "/" & myDay & myMonth & myYear & ".xml"
End If
xDoc.Load strURL
Set KurListesi = xDoc.DocumentElement
Select Case DovTip
Case Is = "USD"
Select Case Tipi
Case Is = "Döviz Alış"
retval = KurListesi.ChildNodes(0).ChildNodes(3).Text
Case Is = "Döviz Satış"
retval = KurListesi.ChildNodes(0).ChildNodes(4).Text
Case Is = "Efektif Alış"
retval = KurListesi.ChildNodes(0).ChildNodes(5).Text
Case Is = "Efektif Satış"
retval = KurListesi.ChildNodes(0).ChildNodes(6).Text
End Select
Case Is = "EUR"
Select Case Tipi
Case Is = "Döviz Alış"
retval = KurListesi.ChildNodes(3).ChildNodes(3).Text
Case Is = "Döviz Satış"
retval = KurListesi.ChildNodes(3).ChildNodes(4).Text
Case Is = "Efektif Alış"
retval = KurListesi.ChildNodes(3).ChildNodes(5).Text
Case Is = "Efektif Satış"
retval = KurListesi.ChildNodes(3).ChildNodes(6).Text
End Select
End Select
20:
If IsEmpty(retval) Then retval = 0
TCMB_Kur = Replace(retval, ".", ",") + 0
End FunctionRE: Tabloya Döviz Kurlarının Getirilmesi - atoykan - 25/06/2023
Kod:
Function TCMB_Kur(Tarih As Date, DovTip As String, Tipi As String) As Variant
On Error GoTo ErrorHandler
Dim xDoc As Object
Set xDoc = CreateObject("MSXML2.DOMDocument")
xDoc.async = False
xDoc.validateOnParse = False
Dim strURL As String
Dim retval As Variant
If Tarih = Date Then
strURL = "http://www.tcmb.gov.tr/kurlar/today.xml"
Else
If Weekday(Tarih, vbMonday) = 6 Then
Tarih = Tarih - 1
ElseIf Weekday(Tarih, vbMonday) = 7 Then
Tarih = Tarih - 2
End If
Dim myDay As String
Dim myMonth As String
Dim myYear As String
myDay = Format(Day(Tarih + 0), "00")
myMonth = Format(Month(Tarih + 0), "00")
myYear = Year(Tarih + 0)
strURL = "http://www.tcmb.gov.tr/kurlar/" & myYear & myMonth & "/" & myDay & myMonth & myYear & ".xml"
End If
xDoc.Load strURL
Dim KurListesi As Object
Set KurListesi = xDoc.DocumentElement
Select Case DovTip
Case "USD"
Select Case Tipi
Case "Döviz Alış"
retval = KurListesi.ChildNodes(0).ChildNodes(3).Text
Case "Döviz Satış"
retval = KurListesi.ChildNodes(0).ChildNodes(4).Text
Case "Efektif Alış"
retval = KurListesi.ChildNodes(0).ChildNodes(5).Text
Case "Efektif Satış"
retval = KurListesi.ChildNodes(0).ChildNodes(6).Text
End Select
Case "EUR"
Select Case Tipi
Case "Döviz Alış"
retval = KurListesi.ChildNodes(3).ChildNodes(3).Text
Case "Döviz Satış"
retval = KurListesi.ChildNodes(3).ChildNodes(4).Text
Case "Efektif Alış"
retval = KurListesi.ChildNodes(3).ChildNodes(5).Text
Case "Efektif Satış"
retval = KurListesi.ChildNodes(3).ChildNodes(6).Text
End Select
End Select
If IsEmpty(retval) Then retval = 0
TCMB_Kur = Replace(retval, ".", ",") + 0
Exit Function
ErrorHandler:
TCMB_Kur = 0
End FunctionRE: Tabloya Döviz Kurlarının Getirilmesi - truhi - 26/06/2023
(25/06/2023, 19:14)atoykan yazdı:olarak dener misiniz örneğiniz olmadığı için uyarlayıp deneme şansım yok.Kod:Function TCMB_Kur(Tarih As Date, DovTip As String, Tipi As String) As Variant
On Error GoTo ErrorHandler
Dim xDoc As Object
Set xDoc = CreateObject("MSXML2.DOMDocument")
xDoc.async = False
xDoc.validateOnParse = False
Dim strURL As String
Dim retval As Variant
If Tarih = Date Then
strURL = "http://www.tcmb.gov.tr/kurlar/today.xml"
Else
If Weekday(Tarih, vbMonday) = 6 Then
Tarih = Tarih - 1
ElseIf Weekday(Tarih, vbMonday) = 7 Then
Tarih = Tarih - 2
End If
Dim myDay As String
Dim myMonth As String
Dim myYear As String
myDay = Format(Day(Tarih + 0), "00")
myMonth = Format(Month(Tarih + 0), "00")
myYear = Year(Tarih + 0)
strURL = "http://www.tcmb.gov.tr/kurlar/" & myYear & myMonth & "/" & myDay & myMonth & myYear & ".xml"
End If
xDoc.Load strURL
Dim KurListesi As Object
Set KurListesi = xDoc.DocumentElement
Select Case DovTip
Case "USD"
Select Case Tipi
Case "Döviz Alış"
retval = KurListesi.ChildNodes(0).ChildNodes(3).Text
Case "Döviz Satış"
retval = KurListesi.ChildNodes(0).ChildNodes(4).Text
Case "Efektif Alış"
retval = KurListesi.ChildNodes(0).ChildNodes(5).Text
Case "Efektif Satış"
retval = KurListesi.ChildNodes(0).ChildNodes(6).Text
End Select
Case "EUR"
Select Case Tipi
Case "Döviz Alış"
retval = KurListesi.ChildNodes(3).ChildNodes(3).Text
Case "Döviz Satış"
retval = KurListesi.ChildNodes(3).ChildNodes(4).Text
Case "Efektif Alış"
retval = KurListesi.ChildNodes(3).ChildNodes(5).Text
Case "Efektif Satış"
retval = KurListesi.ChildNodes(3).ChildNodes(6).Text
End Select
End Select
If IsEmpty(retval) Then retval = 0
TCMB_Kur = Replace(retval, ".", ",") + 0
Exit Function
ErrorHandler:
TCMB_Kur = 0
End Function
Çok teşekkürler Hocam