kurun efektif alış ve satışı

1 2
01/03/2013, 14:05

Yandemir

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
1 2