Çözüldü Güncel altın fiyatları

[k0081]

Merhaba arkadaşlar;

https://altin.in/

Bu sitedeki güncel altın alış fiyatlarını ve eski tarihli fiyatları ( tarih girerek )

Mesaj kutusunda nasıl alabiliriz ?

Bir kaç deneme yaptım. Fakat sağlıklı sonuç alamadım.


Yardımcı arkadaşa şimdiden Teşekkür ederim.

 

[PLİNT]

Merhaba
Gram altın içinse aşağıdaki kodları deneyin,
"tr" tanımını siz ayarlarsınız

tr = Date 
yıl = Year(tr)
ay = Format(tr, "mm")
gun = Format(tr, "dd")
Set ie = CreateObject("internetexplorer.application")
ie.Visible = False: ie.Navigate "https://altin.in/arsiv/" & yıl & "/" & ay & "/" & gun
Do While ie.Busy And Not ie.ReadyState = READYSTATE_COMPLETE
DoEvents: Loop:
Application.Wait (Now + TimeValue("0:00:03"))
For Each j In ie.document.getElementById("icerik").getElementsByClassName("kurlar bordernone")
If j.getElementsByTagName("li")(0).innertext = "Gram Altın Fiyatları" Then
MsgBox "Gram Altın Alış  : " & j.getElementsByTagName("li")(1).innertext & vbCrLf & "Gram Altın Satış : " & j.getElementsByTagName("li")(2).innertext
exit for
end if
Next
ie.Quit

 

[Tevfik_Kursun]

Merhaba Sayın Plint,
Tarih değişse de gelen rakamlar değişmiyor. Neden olabilir?
Saygılarımla

 

[PLİNT]

Merhaba
Ek dosyayı denermisiniz?
Kodlarda "tr" tanımı istediğiniz tarih olarak değişmeli
(önceki kodlarda "[A1]" "Date" yerine aktif edilmeliydi)
Dosyada
For t = 1 To 4
tr = Date - t
ile dört gün geriye doğru yazacaktır
https://we.tl/t-XWDCGiQkQX
veya
https://www.dosyaupload.com/65j8

 

[Tevfik_Kursun]

Teşekkür ederim arkadaşım
Saygılarımla

 

[PLİNT]

Rica ederim, saygı bizden, kolay gelsin

 

[k0081]

PLİNT;

Hocam kod için teşekkürler.

Set ie = CreateObject("internetexplorer.application")

yerine;

Set obj = CreateObject("MSXML2.XMLHTTP") kullansak kodları nasıl değiştirmeliyiz ?

kurlar bordernone, li, icerik Bu değişkenleri nasıl tayin ettiniz ?

 

[PLİNT]

PLİNT;

Set obj = CreateObject("MSXML2.XMLHTTP") kullansak kodları nasıl değiştirmeliyiz ?

Merhaba
Aşağıdaki gibi deneyin

Dim a As Object: Set a = CreateObject("htmlFile")
Dim x As Object, tr As Date, yıl As String, ay As String, gun As String
tr = Date
yıl = Year(tr)
ay = Format(tr, "mm")
gun = Format(tr, "dd")
Set x = CreateObject("MSXML2.XMLHTTP")
x.Open "Get", "https://altin.in/arsiv/" & yıl & "/" & ay & "/" & gun & """, False"
x.send
Application.Wait (Now + TimeValue("0:00:05")) 'internet hızına göre
a.body.innerHTML = x.responseText
Set c = a.getElementById("icerik")
On Error Resume Next
'msgbox c.innertext 'incelemesi ile aşağıdaki
MsgBox c.Children(0).Children(4).Children(10).innertext
x.Close
Set x = Nothing

PLİNT;
kurlar bordernone, li, icerik Bu değişkenleri nasıl tayin ettiniz ?

Kodlarla "id", "classname" değişkenlerini öğrenme imkanı var ama "firefox" ta "öğeyi incele" ile buluyorum
"ie" de Araçlar/F12 Geliştirici arçaları ile bulunabilir.

 

[k0081]

Merhaba
Aşağıdaki gibi deneyin

Dim a As Object: Set a = CreateObject("htmlFile")
Dim x As Object, tr As Date, yıl As String, ay As String, gun As String
tr = Date
yıl = Year(tr)
ay = Format(tr, "mm")
gun = Format(tr, "dd")
Set x = CreateObject("MSXML2.XMLHTTP")
x.Open "Get", "https://altin.in/arsiv/" & yıl & "/" & ay & "/" & gun & """, False"
x.send
Application.Wait (Now + TimeValue("0:00:05")) 'internet hızına göre
a.body.innerHTML = x.responseText
Set c = a.getElementById("icerik")
On Error Resume Next
'msgbox c.innertext 'incelemesi ile aşağıdaki
MsgBox c.Children(0).Children(4).Children(10).innertext
x.Close
Set x = Nothing

Kodlarla "id", "classname" değişkenlerini öğrenme imkanı var ama "firefox" ta "öğeyi incele" ile buluyorum
"ie" de Araçlar/F12 Geliştirici arçaları ile bulunabilir.

Hocam çok teşekkür ederim. Kahvedeyim de, eve geçince kodları test edeceğim..

 

[k0081]

Plint ;


Hocam çok teşekkür ederim. elinize sağlık. Tamamdır..

"id", "classname" her web sitesinde sabitmidir ?

 

[PLİNT]

Rica ederim, kolay gelsin.
Class ve id sabit değil içiçe de olabilir
İncelerseniz bir çok anlatım bulabilirsiniz.

 

[baydeniro]

Merhaba
Gram altın içinse aşağıdaki kodları deneyin,
"tr" tanımını siz ayarlarsınız

tr = Date
yıl = Year(tr)
ay = Format(tr, "mm")
gun = Format(tr, "dd")
Set ie = CreateObject("internetexplorer.application")
ie.Visible = False: ie.Navigate "https://altin.in/arsiv/" & yıl & "/" & ay & "/" & gun
Do While ie.Busy And Not ie.ReadyState = READYSTATE_COMPLETE
DoEvents: Loop:
Application.Wait (Now + TimeValue("0:00:03"))
For Each j In ie.document.getElementById("icerik").getElementsByClassName("kurlar bordernone")
If j.getElementsByTagName("li")(0).innertext = "Gram Altın Fiyatları" Then
MsgBox "Gram Altın Alış  : " & j.getElementsByTagName("li")(1).innertext & vbCrLf & "Gram Altın Satış : " & j.getElementsByTagName("li")(2).innertext
exit for
end if
Next
ie.Quit

Üstad kod paylaşımı için teşekkürler

 

[Exceldrn]

Tüketiciyi Destekleme Derneği (TÜKDES) Genel Başkanı Süleyman Bakal, internetten alınan gram, çeyrek ve yarım altınların ağırlığında eksiklik olabileceği uyarısında bulundu. Altın fiyatları iplerini kopardılarda gidiyorlar.

Gram altın şu anda: 307.66
Ons altın şu anda: 1582.39

 

[dknforst]

Merhaba
Gram altın içinse aşağıdaki kodları deneyin,
"tr" tanımını siz ayarlarsınız

tr = Date
yıl = Year(tr)
ay = Format(tr, "mm")
gun = Format(tr, "dd")
Set ie = CreateObject("internetexplorer.application")
ie.Visible = False: ie.Navigate "https://altin.in/arsiv/" & yıl & "/" & ay & "/" & gun
Do While ie.Busy And Not ie.ReadyState = READYSTATE_COMPLETE
DoEvents: Loop:
Application.Wait (Now + TimeValue("0:00:03"))
For Each j In ie.document.getElementById("icerik").getElementsByClassName("kurlar bordernone")
If j.getElementsByTagName("li")(0).innertext = "Gram Altın Fiyatları" Then
MsgBox "Gram Altın Alış  : " & j.getElementsByTagName("li")(1).innertext & vbCrLf & "Gram Altın Satış : " & j.getElementsByTagName("li")(2).innertext
exit for
end if
Next
ie.Quit

Hocam merhaba,

Öncelikle elinize sağlık.
Bu tabloyu mesajda çıkartmak yerine, x bir sheette A1'e yazdırmak istersek ne yapmamız gerekiyor?

 

[Tevfik_Kursun]

Merhaba,
tr = [A1].value
yazın yeter
iyi çalışmalar

 

[ÖmerFaruk]

'Alış fiyatı için
Worksheets(x).[A1]= j.getElementsByTagName("li")(1).innertext
'Satış fiyatı için
Worksheets(x).[A2]= j.getElementsByTagName("li")(2).innertext
'x olan yere sayfa isminizi girersiniz.

 

[dknforst]

Hocalar merhaba tekrardan,

Öncelikle hızlı desteğiniz için teşekkürler.
Makro ile çok içli dışlı değilim, belirtilen kodu nereye eklemem gerekiyor?

Sub ALTIN_CEK()

tr = Date

yıl = Year(tr)

ay = Format(tr, "mm")

gun = Format(tr, "dd")

Set ie = CreateObject("internetexplorer.application")

ie.Visible = False: ie.Navigate "https://altin.in/arsiv/" & yıl & "/" & ay & "/" & gun

Do While ie.Busy And Not ie.ReadyState = READYSTATE_COMPLETE

DoEvents: Loop:

For Each j In ie.document.getElementById("icerik").getElementsByClassName("kurlar bordernone")

If j.getElementsByTagName("li")(0).innertext = "Gram Altın Fiyatları" Then

MsgBox "Gram Altın Alış  : " & j.getElementsByTagName("li")(1).innertext & vbCrLf & "Gram Altın Satış : " & j.getElementsByTagName("li")(2).innertext

Exit For

End If

Next

ie.Quit

End Sub

 

[ÖmerFaruk]

Bu tabloyu mesajda çıkartmak yerine, x bir sheette A1'e yazdırmak istersek ne yapmamız gerekiyor?


MsgBox "Gram Altın Alış : " & j.getElementsByTagName("li")(1).innertext & vbCrLf & "Gram Altın Satış : " & j.getElementsByTagName("li")(2).innertext

Bu satırın yerine yazabilirsiniz.

 

[dknforst]


MsgBox "Gram Altın Alış : " & j.getElementsByTagName("li")(1).innertext & vbCrLf & "Gram Altın Satış : " & j.getElementsByTagName("li")(2).innertext

Bu satırın yerine yazabilirsiniz.

Merhaba,

Şöyle bir hata alıyorum.

Screenshot

Captured with Lightshot

prnt.sc

Screenshot

Captured with Lightshot

prnt.sc

 

[Haluk]

Sayfa ismini tırnak içinde yazın ..... "Altın"

.