XML 5.0 kullanarak alır.

Private Sub Detail_Click()

On Error Resume Next

 Dim TarihNedir As Date

 TarihNedir = InputBox(Date, Date, Date)

 Me.Kurs = ""

 Dim xmlDoc As MSXML2.DOMDocument50

 Dim DovizListesi As MSXML2.IXMLDOMNodeList

 Dim Dovizler As MSXML2.IXMLDOMNode

 Dim DovizCinsi, CurrName, Alis, Satis

 

 Set xmlDoc = New MSXML2.DOMDocument50

 xmlDoc.async = False

 

'Dim i As Integer

Do Until TarihNedir > Date



 If CVDate(TarihNedir) < Date Then

  xmlDoc.Load "http://www.tcmb.gov.tr/kurlar/" & Format(TarihNedir, "yyyymm") & "/" & Format(TarihNedir, "ddmmyyyy") & ".xml"

 Else

  xmlDoc.Load "http://www.tcmb.gov.tr/kurlar/today.xml"

 End If

 

Set DovizListesi = xmlDoc.documentElement.selectNodes("Currency")

 

   For Each Dovizler In DovizListesi

    DovizCinsi = Dovizler.Attributes.Item(1).nodeValue

    CurrName = Dovizler.selectSingleNode("Isim").Text

    Alis = Dovizler.selectSingleNode("ForexBuying").Text

    Satis = Dovizler.selectSingleNode("ForexSelling").Text

    AlisB = Dovizler.selectSingleNode("BanknoteBuying").Text

    SatisB = Dovizler.selectSingleNode("BanknoteSelling").Text

 

    Me.Kurs = Me.Kurs & CVDate(TarihNedir) & " / " & DovizCinsi & " / " & CurrName & " / " & Val(Alis) & " / " & Val(Satis) & " / " & Val(AlisB) & " / " & Val(SatisB) & vbCrLf

   

   Next

    TarihNedir = TarihNedir + 1

  Loop

  Set xmlDoc = Nothing

  MsgBox "Tamamlandı"

 

Hata:

Exit Sub

End Sub