Tabloya Döviz Kurlarının Getirilmesi

24/06/2023, 23:10

truhi

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 Function
25/06/2023, 19:14

atoykan

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
olarak dener misiniz örneğiniz olmadığı için uyarlayıp deneme şansım yok.
26/06/2023, 22:12

truhi

(25/06/2023, 19:14)atoykan yazdı:
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
olarak dener misiniz örneğiniz olmadığı için uyarlayıp deneme şansım yok.

Çok teşekkürler Hocam