AccessTr.neT

Tam Versiyon: Tabloya Döviz Kurlarının Getirilmesi
Şu anda arşiv modunu görüntülemektesiniz. Tam versiyonu görüntülemek için buraya tıklayınız.
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
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.
(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