AccessTr.neT

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ışı