kurun efektif alış ve satışı

Merhaba arkadaşlar,
aşağıdaki kur alış koduna dolar effektif alış ve effektif satışı nasıl ekleyebilirim.?

Sub GünlükKurlar()

Dim strPathB As String

Dim IEb As Object

Dim tempB As Variant



strPathB = "http://www.tcmb.gov.tr/kurlar/today.html"



 Set IEb = CreateObject("InternetExplorer.Application")

 With IEb

 .Navigate strPathB

 Do Until IEb.ReadyState = 4: DoEvents: Loop

 

 temp = IEb.Document.All.Item.innerHTML

 End With

 Me.txtGünlükDolarAlış = Val(Replace(Mid(temp, InStr(temp, "USD") + 42, 6), ",", ""))

 Me.txtGünlükDolarSatış = Val(Replace(Mid(temp, InStr(temp, "USD") + 55, 6), ",", ""))

 Me.txtGünlükEuroAlış = Val(Replace(Mid(temp, InStr(temp, "EUR") + 42, 6), ",", ""))

 Me.txtGünlükEuroSatış = Val(Replace(Mid(temp, InStr(temp, "EUR") + 55, 6), ",", ""))

 Set IEb = Nothing

 Me.Liste6.Requery

 DoCmd.Requery



End Sub

Bu şekilde deneyin.

Sub GünlükKurlar()

Dim strPathB As String

Dim IEb As Object

Dim tempB As Variant



strPathB = "http://www.tcmb.gov.tr/kurlar/today.html"



 Set IEb = CreateObject("InternetExplorer.Application")

 With IEb

 .Navigate strPathB

 Do Until IEb.ReadyState = 4: DoEvents: Loop

 

 temp = IEb.Document.All.Item.innerHTML

 End With

 Me.txtGünlükDolarAlış = Val(Replace(Mid(temp, InStr(temp, "USD") + 42, 6), ",", ""))

 Me.txtGünlükDolarSatış = Val(Replace(Mid(temp, InStr(temp, "USD") + 55, 6), ",", ""))

 Me.txtGünlükEuroAlış = Val(Replace(Mid(temp, InStr(temp, "EUR") + 42, 6), ",", ""))

 Me.txtGünlükEuroSatış = Val(Replace(Mid(temp, InStr(temp, "EUR") + 55, 6), ",", ""))

Me.txtGünlükDolarEAlış = Val(Replace(Mid(temp, InStr(temp, "USD") + 71, 6), ",", ""))

Me.txtGünlükDolarESatış = Val(Replace(Mid(temp, InStr(temp, "USD") + 84, 6), ",", ""))

Me.txtGünlükEuroEAlış = Val(Replace(Mid(temp, InStr(temp, "EUR") + 71, 6), ",", ""))

Me.txtGünlükEurorESatış = Val(Replace(Mid(temp, InStr(temp, "EUR") + 84, 6), ",", ""))

Set IEb = Nothing

 Me.Liste6.Requery

 DoCmd.Requery



End Sub

Çok teşekkür ederim sayın boolean.

Rica ederim

merhaba,

15 Şubat 2013 ten sonra bu kod ile çağırmakta olduğum döviz kurları EURO 2 TL USD 1 TL olarak gelmeye başladı. Neden olabilir.

bu daha kolay bir kod

Function kural()
Dim objXML As MSXML2.DOMDocument
Set objXML = CreateObject("MSXML2.DOMDocument")
objXML.async = False
objXML.validateOnParse = False
objXML.Load ("http://www.tcmb.gov.tr/kurlar/today.xml")
MsgBox objXML.documentElement.childNodes(0).childNodes(1).Text
MsgBox objXML.documentElement.childNodes(0).childNodes(3).Text
MsgBox objXML.documentElement.childNodes(0).childNodes(4).Text
MsgBox objXML.documentElement.childNodes(0).childNodes(5).Text
End Function

childNodes(0).childNodes(5) 0 ıncı satırın 5.stununa denk gelen veri yani doların efektif alışı