Yardım Webden belirli döviz kurlarını çekme

aliakgun

Yeni Üye
Katılım
12 May 2019
Mesajlar
5
Puanları
1
Yaş
26
Konum
Eskişehir
Ad Soyad
Ali Akgün

Butona basıldığında sırasıyla : Dolar, Euro, İngiliz Sterlini, Japon Yeni, Kanada Doları, İsveç Kronu döviz bilgilerini yukarıdaki siteden "kurlar" sayfasına aldıktan sonra sırasıyla ayrı ayrı Excel sayfalarına yazan makro kodları gerekiyor. Uğraştım ama bir sonuca varamadım. Yardım edebilecek arkadaşlara şimdiden çok teşekkür ederim. Dosya ektedir.
 

Ekli dosyalar

Evren

Uzman
Katılım
9 Haz 2018
Mesajlar
101
Puanları
28
Yaş
58
Konum
Emekli
Sayın PLINT in kodları.
Kendinize göre uyarlayınız.:cool:
Kod:
Dim s As Long
Dim ie, t
[A2:E10] = ""
Set ie = CreateObject("internetexplorer.application")
ie.Visible = False: ie.Navigate "http://www.tcmb.gov.tr/kurlar/today.xml"
Do While ie.Busy And Not ie.ReadyState = READYSTATE_COMPLETE
DoEvents: Loop
Set st = ie.document.getElementById("kurlarContainer")
On Error Resume Next
For Each t In st.getElementsByTagName("*")
If Trim(t.Children(0).innertext) = "USD/TRY" Or Trim(t.Children(0).innertext) = "EUR/TRY" _
Or Trim(t.Children(0).innertext) = "GBP/TRY" Then
s = Cells(Rows.Count, 1).End(3).Row + 1
Cells(s, 1) = t.Children(0).innertext
Cells(s, 2) = t.Children(3).innertext
Cells(s, 3) = t.Children(4).innertext
Cells(s, 4) = t.Children(5).innertext
Cells(s, 5) = t.Children(6).innertext
End If
Next
Set st = Nothing
ie.Quit
 

aliakgun

Yeni Üye
Katılım
12 May 2019
Mesajlar
5
Puanları
1
Yaş
26
Konum
Eskişehir
Ad Soyad
Ali Akgün
Sn.Evren hocam 4. ve 5. kuru çekerken sürekli hata alıyorum. Nasıl yapabilirim yardımcı olur musunuz?
 

aliakgun

Yeni Üye
Katılım
12 May 2019
Mesajlar
5
Puanları
1
Yaş
26
Konum
Eskişehir
Ad Soyad
Ali Akgün
Bu konularda çok acemiyim. Kodlar çalışıyor ve 3 kuru getiriyor.Ben ekstradan kur eklediğimde ise hata alıyorum. Nasıl yapabilirim acaba
 

Evren

Uzman
Katılım
9 Haz 2018
Mesajlar
101
Puanları
28
Yaş
58
Konum
Emekli
ekstradan japon yeni, kanada doları, isveç kronu
Buyurun.:cool:
Kod:
Sub webten_verial()
Dim s As Long
Dim ie, t
[A2:E10] = ""
Set ie = CreateObject("internetexplorer.application")
ie.Visible = False: ie.Navigate "http://www.tcmb.gov.tr/kurlar/today.xml"
Do While ie.Busy And Not ie.ReadyState = READYSTATE_COMPLETE
DoEvents: Loop
Set st = ie.document.getElementById("kurlarContainer")
On Error Resume Next
For Each t In st.getElementsByTagName("*")
If Trim(t.Children(0).innertext) = "USD/TRY" Or Trim(t.Children(0).innertext) = "EUR/TRY" _
Or Trim(t.Children(0).innertext) = "GBP/TRY" Or Trim(t.Children(0).innertext) = "JPY/TRY" _
Or Trim(t.Children(0).innertext) = "CAD/TRY" Or Trim(t.Children(0).innertext) = "SEK/TRY" Then
s = Cells(Rows.Count, 1).End(3).Row + 1
Cells(s, 1) = t.Children(0).innertext
Cells(s, 2) = t.Children(3).innertext
Cells(s, 3) = t.Children(4).innertext
Cells(s, 4) = t.Children(5).innertext
Cells(s, 5) = t.Children(6).innertext
End If
Next
Set st = Nothing
ie.Quit
End Sub
 

Evren

Uzman
Katılım
9 Haz 2018
Mesajlar
101
Puanları
28
Yaş
58
Konum
Emekli
Haluk beyin kodları, direk xml'den veri alıyor.
İE ' yi açmıyor.
Birde bunları deneyiniz.:cool:
Kod:
Sub XMLDosyasiniOku_HD()
    'Haluk
    '06/08/2018 - 13/05/2019
    '
    Dim XDoc As Object, strURL As String
    Dim myList As Object
    Dim Num As Byte
  
    Range("A2:G100") = ""

    Set XDoc = CreateObject("MSXML2.DOMDocument")
    XDoc.async = False
    XDoc.validateOnParse = False
    strURL = "http://www.tcmb.gov.tr/kurlar/today.xml"
    XDoc.Load strURL
    'Set myList = XDoc.SelectNodes("//Currency") HEPSİNİ LİSTELEMEK İÇİN
    Set myList = XDoc.SelectNodes("//Currency[CurrencyName='US DOLLAR' or CurrencyName='JAPENESE YEN' or CurrencyName='SWISS FRANK']")
    If myList.Length = 0 Then GoTo SafeExit:
    Num = myList.Length - 1
    For i = 0 To Num
        Cells(i + 2, 1) = i + 1
        Cells(i + 2, 2) = myList(i).ChildNodes(0).Text
        Cells(i + 2, 3) = myList(i).ChildNodes(1).Text
        Cells(i + 2, 4) = myList(i).ChildNodes(3).Text
        Cells(i + 2, 5) = myList(i).ChildNodes(4).Text
        Cells(i + 2, 6) = myList(i).ChildNodes(5).Text
        Cells(i + 2, 7) = myList(i).ChildNodes(6).Text
    Next
SafeExit:
    Set myList = Nothing
    Set XDoc = Nothing
MsgBox "bitti"
End Sub
 
Üst Alt